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RETINAL  THERMAL  MODEL  OF  LASER-INDUCED  EYE  DAMAGE: 
COMPUTER  PROGRAM  OPERATOR'S  MANUAL 


INTRODUCTION 

The  Retinal  Thermal  Model  is  a mathematical  model  that  predicts  the 
thermal  eye  damage  resulting  from  an  exposure  to  laser  radiation.  This 
program,  developed  by  the  Illinois  Institute  of  Technology  Research 
Institute,  is  a result  of  many  years  of  improvements  in  thermal  damaqe 
modeling  techniques.  The  mathematical  basis  for  temperature  predictions 
computed  in  the  model  is  the  standard  heat-conduction  equation  in  cylin- 
drical coordinates 

[pcjnr*  + k[?!f+  377] + 

where  C ■ specific  heat 
P = density 

q ■ rate  of  heat  deposition  from  the  laser 
K = thermal  conductivity 
r = radial  distance 
2 = axial  distance 
t = time 

v = temperature  rise  above  the  initial  temperature 

The  heat-conduction  equation  is  approximated  by  finite  differences 
and  then  solved  with  an  explicit-implicit  alternating-direction  technique 
developed  by  D.  W.  Peaceman  and  H.  H.  Rachford  (1).  This  technique  solves 
the  finite-difference  equations  explicitly  in  z and  implicitly  in  r for 
odd  time  steps,  and  implicitly  in  z and  explicitly  in  r for  even  time  steps. 
In  explicit  calculations,  existing  temperatures  are  used  to  represent  ther- 
mal gradients;  in  Implicit  calculations,  future  temperatures  are  used. 

This  approach  results  in  a set  of  equations  that  are  solved  using  ordinary 
matrix  algebra.  Larger  time  intervals  can  be  used  with  this  technique 
than  with  standard  explicit  finite-difference  methods.  The  model  uses  the 
predicted  temperature  rises  to  determine  Irreversible  tissue  damage  by 
applying  Henri que's  damage  criteria 

Afl(z,r,t)  » Ciexp[C2/Ta(z,r,t)]At 


T.  Peaceman,  D.  W.,  and  H.  H.  Rachford,  Jr.  The  numerical  solution 
of  parabolic  and  elliptic  differential  equations.  J Soc  Indust 
Appl  Math  3:28-41  (1955). 
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where  Afl(z,r,t)  = Incremental  damage  at  point  z,  r 
C]  and  C?  ■ rate  constants 
Ta(z,r,t)  * absolute  temperature 
At  ■ increment  of  time. 

Irreversible  tissue  damage  is  defined  as  occurring  whenever  the  inte- 
gral of  Afl  over  all  time  is  greater  than  or  equal  to  1.  Froni  this  mathe- 
matical basis,  the  model  has  the  capability  of  predicting  temperature 
rises,  damage  thresholds,  and  the  extent  of  damage  for  specified  sets  of 
spatial  coordinates  within  the  ocular  media.  The  model  also  has  the 
capability  to  predict  the  retinal  intensity  distribution  from  the  inten- 
sity distribution  at  the  cornea.  This  ODtical  snread  capability  has  its 
basis  in  scalar  diffraction  theory,  using  the  Fresnel  approximation  and 
adding  terms  to  account  for  defocusing  and  ocular  aberrations. 

The  Retinal  Thermal  Model  has  been  divided  into  two  programs,  RE1 
and  RE2.  Both  programs  perform  the  same  tasks  with  one  exception— RE1 
contains  the  subroutine  MXGRAN,  which  models  the  melanin  granules,  while 
RE2  does  not  contain  MXGRAN. 

Designed  for  maximum  flexibility,  the  model  offers  wide  variability 
in  both  input  and  output.  It  accommodates  variations  in  laser  radiation 
characteristics  and  in  optical,  thermal,  and  physiological  properties  of 
the  eye.  The  model's  design  enables  the  user  to  specify  his  region  of 
interest  within  the  retinal  layers  and  to  print  out  only  those  portions 
of  the  output  information  which  he  desires. 

The  purpose  of  this  manual  is  to  give  the  user  a basic  understand- 
ing of  the  model's  capabilities  and  how  to  use  it  within  the  limits  of 
those  capabilities.  A meaningful  description  of  a model  of  this  type  and 
flexibility,  however,  cannot  be  written  without  some  complexity;  and  an 
individual  will  usually  need  some  study  and  practical  experience  before 
feeling  comfortable  with  the  model.  Additional  information  on  the  code 
can  be  obtained  from  the  IITRI  Technical  Report,  "Thermal  Model  of 
Laser-Induced  Eye  Damage"  (2). 

This  manual  briefly  describes  (1)  the  capabilities  and  limitations 
of  the  model  as  they  pertain  to  the  source,  the  eye,  the  mechanics  of 
the  program,  and  the  output  desired;  (2)  the  basic  input  required,  list- 
ing the  required  cards,  their  order,  and  appropriate  formats;  and  (3) 
the  printed  output.  Including  its  format  and  the  options  available  to 
the  user.  Appendix  A is  a glossary  of  all  parameters  that  are  either 
input  or  output,  plus  some  parameters  used  internally  in  the  program. 


2.  Takata,  A.  N.,  et  al.  Thermal  model  of  laser-induced  eye  damage. 
Final  Technical  Report,  I IT  Research  Institute  Contract 
F41 609-74-f -0005 , 8 Oct  1974,  USAF  School  of  Aerospace  Medi- 
cine, Brooks  AFB,  Tex.  AD  A017201. 
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Appendix  B briefly  describes  the  PLOT  routine  that  can  be  used  with  the 
retinal  model  to  obtain  two-  and  three-dimensional  plots  of  the  pre- 
dicted temperature  rises.  Appendix  C covers  the  steps  necessary  to  run 
the  program  on  the  IBM  360/65  computer  at  the  San  Antonio  Data  Service 
Center  (SADSC),  a computer  facility  available  throuqh  a remote  job-entry 
terminal  located  in  the  Biometrics  Division,  USAF  School  of  Aerospace 
Medicine  (USAFSAM),  Brooks  AFB,  Tex.  A description  is  included  of  the 
job-control  language  cards  required  to  enter  the  proqram  on  the  com- 
puter. Appendix  D is  a listing  of  the  RE1  and  RE2  programs  and  PLOT. 

This  manual  is  designed  as  a user's  reference  for  the  IITRI  retinal 
model  as  it  existed  in  November  1975.  This  version  differs  mainly  in 
output  format  from  the  version  described  in  the  IITRI  Technical  Report. 


CAPABILITIES  AND  LIMITATIONS 

The  user  is  responsible  for  adequately  describing  the  exposure  con- 
ditions to  be  modeled  and  the  predictions  (retinal  intensity  distribu- 
tion, temperature  rises,  damage  thresholds  or  extent  of  damaqe)  he 
desires  from  the  model.  He  must  describe,  or  model,  the  incident  radia- 
tion, the  ocular  media,  the  mechanics  (temporal  and  spatial  qrid)  of  the 
program,  and  the  output  desired.  This  section  nresents  a broad  overview 
of  the  capabilities  and  limitations  as  they  pertain  to  these  four  areas. 

In  developing  the  program,  several  major  assumptions  are  made. 

First,  the  eye  geometries  are  simulated  in  cylindrical  coordinates,  approx- 
imating the  retina  as  a flat  surface.  Second,  the  relative  retinal- 
intensity  radial  distribution  is  used  at  all  depths  of  the  eye  below  the 
retina,  assuming  that  the  incident  radiation  is  coherent  and  dispersion 
of  the  beam  through  the  retina  will  be  minimal.  Third,  all  reflected 
radiation  is  considered  to  move  along  axial  directions;  also,  only  first- 
order  reflections  are  considered  to  be  important  to  the  total  temperature 
rise.  Fourth,  the  rates  of  retinal -tissue  damage  used  in  the  damage  in- 
tegral are  assumed  to  equate  to  the  rates  of  skin- tissue  damage;  extensive 
work  has  been  done  with  skin  tissue  in  this  area  while  very  little  has  been 
done  with  the  retina.  Other  assumptions  will  be  discussed  in  later  sec- 
tions. 


The  model  has  a number  of  features  which  give  the  user  flexibility  in 
describing  the  incident  radiation  in  terms  of  its  spatial,  spectral,  and 
temporal  properties.  The  model  is  designed  only  for  monochromatic,  coher- 
ent radiation.  The  spatial  profile  of  the  beam  may  be  designated  as 
uniform,  gaussian,  or  irregular.  Symmetry  about  the  axis  of  propagation  is 
always  assumed.  The  user  may  specify  the  profile  at  either  the  cornea  or 
the  retina.  For  uniform  or  gaussian  profiles,  the  user  specifies  the  beam 
radius  and  the  total  power  incident  during  a single  pulse.  For  irregular 
profiles,  the  user  constructs  the  desired  beam  profile  by  specifying  the 
total  power  incident  during  a single  pulse  and  the  Intensity  (absolute  or 
relative)  and  associated  radial  distances  from  the  center  of  the  beam. 
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The  temporal  properties  of  the  incident  radiation  are  specified  by 
selecting  the  duration  of  a pulse,  the  repetition  rate,  and  the  number 
of  pulses.  Therefore,  both  single-  and  multiple-pulse  exposures  can  be 
modeled.  The  model  assumes  all  pulses  to  be  square  with  respect  to  time; 
multiple-pulse  trains  will  be  composed  of  simple  periodic,  100%  modu- 
lated pulses.  Because  the  model  only  predicts  damage  based  on  thermal 
mechanisms,  the  recommended  time  range  for  a oulse  duration  is  between 
10-7  and  103  seconds.  For  pulse  durations  outside  this  range,  nonthermal 
damage  mechanisms  may  become  significant.  The  model  will  accommodate 
shorter  pulse  durations;  however,  only  thermal  effects  will  be  predicted. 

The  model  automatically  converts  pulses  with  durations  less  than  3x10-9 
seconds  to  pulses  with  3x1 0-9  -sec  pulse  widths.  The  conversion  is 
accomplished  assuming  energy  conservation.  The  associated  power  conver- 
sions are  also  made  internally  in  the  model.  Even  though  the  model  makes 
these  conversions,  the  output  is  always  given  relative  to  the  original 
input  with  one  exception:  the  value  for  POW,  the  total  power  incident  on 
the  corneal  surface,  is  given  relative  to  the  3x10-9  _Sec  pulse. 

The  ocular  media  can  be  described  in  terms  of  the  optical,  thermal, 
and  physiological  characteristics  of  the  eye.  The  optical  narameters  in- 
clude the  coefficients  for  absorption,  reflection,  aberration,  and  re- 
fraction. Scattering  of  the  radiation  within  the  ocular  media  is  ignored, 
and  all  reflected  radiation  is  along  axial  directions.  The  user  has  the 
option  to  either  specify  an  optical  system  that  calculates  the  retinal 
intensity  distribution  or  specify  the  retinal  intensity  distribution 
directly.  The  optical  system  of  the  eye  is  specified  in  terms  of  focal 
length,  distances  between  optical  surfaces,  refractive  indexes,  aberration 
coefficients,  and  pupil  size.  The  relative  retinal-intensity  radial  dis- 
tribution is  assumed  to  remain  constant  at  all  depths  below  the  retina. 

The  thermal  parameters  include  heat  capacity  and  conductivity  of  the 
individual  ocular  layers.  Initial  ocular  temperature,  and  blood  flow 
within  the  choriocapi Haris  and  tissues  surrounding  the  eye.  The  user  may 
also  specify  the  decay  of  temperature  rises  within  the  melanin  granules 
for  program  RE1 . 

The  user  specifies  the  physiological  characteristics  of  the  eye  by 
selecting  the  radius  and  thicknesses  of  the  various  homogeneous  ocular 
layers.  All  surfaces  are  assumed  to  be  flat  and  perpendicular  to  the 
laser  beam  axis.  The  user  may  divide  the  pigment  epithelium  Into  two  sub- 
layers; also,  the  user  has  the  option  of  placinq  1-um-cube  melanin  granules, 
separated  by  1 pm,  in  either  one  of  the  sublayers  of  the  pigment  epi- 
thelium. The  melanin  granules  are  modeled  as  absorbing  all  energy  incident 
upon  them;  the  surrounding  media  absorb  like  the  choroid.  The  choice  of 
the  sublayer  to  contain  the  melanin  granules  is  used  to  differentiate  be- 
tween the  human  and  the  monkey  eye.  In  the  monkey  eye,  the  melanin  gran- 
ules are  located  in  the  anterior  portion  of  the  pigment  epithelium;  in 
the  human  eye,  in  the  posterior  portion.  The  melanin  granules  contribute 
to  the  temperature  rise  calculations  only  for  pulse  widths  less  than  10-5 
seconds.  For  times  greater  than  10-5  seconds,  the  heat  diffusion  from  one 
granule  to  another  has  already  taken  place;  so  the  temperature  rises  are 


constant  across  the  entire  granulated  layer,  and  the  granules  do  not  con- 
tribute significantly  to  the  temperature  calculations.  For  this  reason, 
the  Retinal  Thermal  Model  has  been  divided  into  two  programs,  RE1  and  RE2. 
RE1  contains  the  subroutine  MXGRAN  which  models  the  melanin  granules  within 
the  pigment  epithelium.  RE2  does  not  contain  MXGRAN  but  does  allow  divi- 
sion of  the  pigment  epithelium  into  two  homogeneous  layers.  RE2  requires 
less  computer  central  processing  time  and  core  memory  than  does  RE1 . 

The  model  automatically  selects  the  temporal  and  spatial  qrid  points 
in  the  ocular  media;  however,  the  user  specifies  the  size  of  the  increments 
and  extent  of  the  temporal  and  spatial  grid.  The  dimensions  of  the  spatial 
and  temporal  increments  represent  the  limits  of  resolution  of  the  model  pre- 
dictions. The  spatial  grid  has  uniform  increments  in  the  region  of  highest 
temperature  rise  and  constantly  expanding  increments  away  from  the  highest 
temperature  regions.  The  temporal  grid  has  constantly  expanding  time  steps 
from  the  beginning  of  the  pulse.  The  predicted  retinal  intensity  distri- 
bution and  temperature  rises  are  all  relative  to  the  specified  spatial  and 
temporal  grid  points.  The  user  selects  the  range  and  spacing  of  spatial 
coordinates  used  to  print  the  temperature  rises,  threshold  powers,  and  ex- 
tent of  damage;  also,  the  user  has  the  option  to  print  and  plot  temperature 
rises  at  any  selected  time.  A separate  plotting  routine  uses  input  data 
cards  punched  by  the  retinal  model  and  user  control  cards  to  plot  the  tem- 
perature rises.  Entire  sections  of  the  complete  printed  output  can  be 
deleted.  Available  options  are  described  in  the  Output  Format  section. 

The  retinal  model  has  a variety  of  input/output  capabilities.  The 
user  can  batch  a sequence  of  exposures  by  varying  the  pulse-repetition 
frequency  and/or  number  of  pulses  while  keeping  all  other  parameters  con- 
stant. For  such  sequence  of  exposures,  the  program  is  initiated  only  once, 
thus  conserving  operating  time. 


INPUT  REQUIREMENTS 

This  section  describes  the  input  required  to  specify  the  source,  the 
ocular  media,  the  mechanics  of  the  program,  and  the  formatting  of  the  output. 
All  parameters  reauired  by  the  user  as  input,  along  with  the  appropriate 
formats  and  data  card  numbers,  are  given  for  retinal  models  RE1  and  RE2. 

All  parameters  are  defined  in  Appendix  A.  When  solving  a problem,  the  user 
must  model  both  the  incident  radiation  and  the  ocular  media  to  fit  the  de- 
sired situation,  and  must  also  specify  the  parameters  governing  the  mechan- 
ical operation  of  the  prooram,  such  as  the  size  of  the  qrid  required  and 
the  output  desired. 

To  simulate  the  radiation  incident  on  the  ocular  media,  the  user  has 
the  option  of  specifying,  via  IPROF,  a uniform-,  gaussian-,  or  irregular- 
beam  irradiance  profile.  Axial  symmetry  for  all  beam  profiles  is  assumed. 

For  uniform-beam  profiles,  the  beam  radius  (RIM)  must  be  specified;  it  is 
used  with  LIM  (the  number  of  radial  intervals  from  the  center  of  the  beam 
to  a specified  radius)  to  establish  the  minimum  radial  grid  increment  (OR). 
For  gaussian-beam  profiles,  RIM  must  be  specified  at  a oarticular  relative 
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intensity  point  (CUT).  For  irregular-beam  profiles,  the  absolute  or 
relative  irradiance  profile  must  be  specified  on  a point-by-point  basis  by 
listing  the  irradiance  value,  PX(L),  at  the  radial  distance,  RX(L),  from 
the  center  of  the  beam.  PX(L)  cannot  have  a value  of  zero  at  the  center 
of  the  beam.  The  total  number  of  specified  irradiance  points  is  equal  to 
LR.  The  model  will  integrate  the  beam  profile  at  radial  intervals  (RINT). 
We  suggest  that  the  irradiance  points  be  specified  at  radial  intervals 
equal  to  multiples  of  RINT  to  avoid  interpolation. 

The  total  power  per  pulse  in  the  beam  at  the  cornea  (POW)  must  be 
specified  for  all  beam  profiles.  In  effect,  the  user  has  the  capability 
of  specifying  the  divergence,  which  is  a function  of  the  distance  of  the 
pupil  from  the  nearest  beam  waist  (ZO).  ZO  is  input  only  if  the  spread 
function  is  used  (IFIL=1).  In  addition,  the  pulse  width  (DPULSE),  the 
pulse  repetition  frequency  (REPET),  the  number  of  pulses  entering  the 
ocular  media  (NPULSE),  and  the  wavelength  (WAVEL)  must  also  be  soecified 
for  all  simulated  exposures.  However,  WAVEL  is  used  only  in  the  image 
spread-function  calculation  (IFIL=1),  For  single-pulse  exposures,  a 
value  for  REPET  must  be  supplied;  however,  it  will  not  be  used  in  calcula- 
tions in  the  model. 

The  eye  is  modeled  as  a cylinder  with  its  axis  coincident  with  the 
axis  of  radiation  propagation.  The  various  layers  of  the  eye  lie  perpen- 
dicular to  the  cylinder  axis,  with  flat  boundaries  between  the  layers. 

The  radial  extent  of  the  eye  is  specified  as  RVL.  The  various  ocular  media 
modeled  in  the  eye  are  listed  in  Table  1.  The  thickness,  transmittance, 
reflectance,  and  absorption  coefficients  of  the  various  layers  are  all 
input.  The  user  must  also  supply  the  thermal  conductivity,  CONX(L),  and 
heat  capacity,  VSHX(L),  for  each  ocular  layer.  Values  for  these  param- 
eters are  given  in  Appendix  A. 


TABLE  1 . OCULAR  STRUCTURES  MODELED 

Label  Ocular  structures 

1 Everything  from  the  anterior  portion 
of  the  eye  to  the  pigment  epithelium 

2 Pigment  epithelium 

3 Choriocapillaris  (vascular  layer) 

4 Choroid 

5 Sclera 

6 Tissue  posterior  to  the  sclera 


8 


The  pigment  epithelium  layer  may  be  divided  into  two  sublayers,  with 
the  user  specifying  the  thickness  and  the  absorption  coefficient  for  each 
sublayer.  IGX  is  the  parameter  used  to  specify  the  absorption  coefficients. 
For  a simulation  of  the  human  eye  (IGX=1),  the  absorption  coefficient  for 
the  anterior  sublayer  (APE1)  is  set  equal  to  the  absorption  coefficient  for 
the  choroid  (ACH);  the  absorption  coefficient  for  the  posterior  sublayer 
(APE2)  Is  calculated  within  the  model.  For  the  simulation  of  the  monkey 
eye  (IGX=0),  the  absorption  coefficient  for  APE1  is  calculated  within  the 
model,  while  APE2  is  set  equal  to  ACH.  The  distinction  of  two  sublayers 
with  differing  absorption  coefficients  is  due  to  the  assumption  that  most 
of  the  absorption  within  the  pigment  epithelium  occurs  in  the  posterior  sec- 
tion for  human  eyes  and  in  the  anterior  section  for  monkey  eves.  The  rela- 
tive thickness  of  the  two  sublayers  is  specified  by  RPE. 


The  user  can  transform  the  distribution  of  the  beam  Incident  on  the 
cornea  to  a retinal  distribution  by  using  the  spread  function  ( IF IL=1 ) or 
can  ignore  that  transformation  (using  IFIL=0)  and  specify  the  intensity 
distribution  at  the  retina.  The  spread  function  simply  transfers  the  beam 
from  the  cornea  to  the  retina,  simulating  ocular  focusing  and  optical 
aberration  effects.  The  initial  temperature  of  the  eye  is  specified  as  TO. 
The  radius  of  the  pupil  of  the  eye  (PUPIL)  is  specified  by  the  user  and 
implemented  within  the  model  to  define  the  initial  beam  intensity  profile. 
Only  when  the  spread  function  is  used  must  ZO,  FLO,  FC,  NB,  PP,  CABER,  PC, 
JO,  and  NA  be  input. 


The  effects  of  blood  flow  are  assessed  in  two  ocular  structures— the 
choriocapil laris  and  the  tissue  surrounding  the  eye.  Within  both  struc- 
tures, the  blood  is  treated  as  a heat  sink— the  extraction  of  heat  from 
the  adjacent  tissue  by  the  blood  as  it  enters  that  tissue.  The  user  inputs 
the  specific  heat  of  blood  (SHB),  the  total  blood  flow  to  the  chorio- 
capillaris (CFLOW),  and  the  rate  of  blood  flow  to  the  tissue  surrounding 
the  eye  (XFLOW).  The  model  computes  the  temperature  rise  resulting  from 
the  heating  of  the  blood  as  it  enters  both  ocular  structures.  The  user 
can  also  account  for  the  radial  transport  of  heat  by  the  radial  flow  of 
blood  within  the  choriocapillaris.  To  do  this,  statement  number  31  of  the 
RE1  and  RE2  programs  (Appendix  D)  must  be  deleted  and  replaced  by  state- 
ments to  establish  specific  values  for  XFLOWO(Ll)  Ll=l,6.  XFLOWO(Ll)  is 
defined  as  the  total  blood  flow  per  unit  area  leaving  the  choriocapillaris 
at  a given  radial  distance  R.  It  is  given  in  units  of  g*cnr2*sec" 1 . With- 
out this  change,  the  model  will  only  treat  blood  as  a heat  sink. 


The  model  also  computes  the  temperature  effects  of  heat  absorption  in 
the  melanin  granules.  The  user  must  specify  TS(L),  which  determines  how 
the  average  temperature  rise  of  the  granules  decays  with  time,  and  LTMAX, 
which  controls  the  time  beyond  which  the  temperature  rises  of  the  melanin 
granules  are  completely  dissipated.  The  temperature-rise  contributions 
are  specified  at  time  Increments  of  3x10-9  seconds.  In  the  output  section 
of  the  model,  XPD(K)  represents  the  degree  to  which  the  melanin  granules 
affect  the  temperature  in  the  pigment  epithelium. 
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To  predict  the  power  required  to  produce  irreversible  damage  by  the 
damage-integral  method,  the  coefficients  for  the  rates  of  damage  (DAMAGE) 
must  be  specified.  The  model  will  also  compute  the  power  required  to 
raise  the  temperature  of  the  tissue  to  TSTEAM  and  will  repeat  the  calcula- 
tion at  temperature  intervals  (DTSTM)  until  the  power  to  produce  irre- 
versible damage,  as  determined  bv  the  damage-integral  method,  is  reached. 

The  mechanics  of  model  operation  include  determining  the  spatial  qrid 
system  and  the  time  intervals  used  in  the  temperature-rise  computation. 

The  spatial  grid  system,  used  to  specify  the  locations  at  which  an  evalua- 
tion of  the  temperature-rise  and  damage-threshold  predictions  is  desired, 
has  both  a uniform  and  a constantly  expanding  portion.  The  uniform  portion 
of  the  grid  is  positioned  at  the  center  of  the  beam  in  the  piqment  epithe- 
lium, usually  the  region  of  highest  temperature  rise.  The  grid  then  con- 
stantly expands  away  from  this  region.  The  user  specifies  the  size  of  the 
uniform  radial  grid  interval  (DR)  by  using  LIM  and  LESION  for  irregular  or 
gaussian  profiles,  and  LIM  and  RIM  for  uniform  profiles.  The  uniform  axial 
grid  interval  is  about  one-sixth  of  the  thickness  of  the  pigment  epithelium. 
Upon  this  qrid  the  physiological  layers  are  constructed.  The  various  ocular 
layers  and  the  labels  used  to  assign  absorption,  conductivity,  and  heat- 
capacity  values  to  these  ocular  layers  are  listed  in  Table  1.  For  damage 
threshold  calculations,  the  range  of  grid  locations  at  which  calculations 
are  made  is  determined  from  LIMAX  and  MAXPRT  for  axial  locations  and  from 
RMAX  for  radial  locations.  LIMAX  and  RMAX  must  be  chosen  so  that 
( ID2-ID1+1 )*  JM  <27  where  ID1=IMAX-LIMAX,  ID2=IMAX+LIMAX,  and  JM  is  the 
index  of  the  first  radial  grid  point  beyond  RMAX.  IMAX  is  the  axial  grid 
point  at  which  peak  temperature  rises  occur  at  the  conclusion  of  the  pulse. 

The  time  intervals  used  in  calculating  temperature  rises,  the  maximum 
time  during  which  temperature  rise  calculations  and  damage  threshold  pre- 
dictions are  made,  and  the  time  intervals  used  to  subdivide  the  pulse 
widths  are  complex  ar.d  intricately  related.  Unless  the  reader  is  experi- 
enced with  the  program,  we  suggest  that  the  values  supplied  in  Appendix  A 
for  FT I ME , EDT1,  EDT2,  NPT.  XCT,  and  KTT  he  used.  Appendix  A contains 
some  of  the  relationships  between  these  parameters  for  those  who  need  to 
change  the  suggested  values. 

To  reduce  computation  time  of  the  program,  the  user  mav  group  all 
exposures  which  differ  only  in  REPET  and  NPULSE.  This  is  done  by  speci- 
fying the  desired  values  for  REPET  and  NPULSE  and  specifying  the  total 
number  of  exposures  so  grouped  in  NTEST,  with  a maximum  cf  7 pairs  of 
values  per  group. 

The  formatting  of  the  output  includes  selecting  the  output  sections 
to  be  printed  and  the  times  and  spatial  ranges  within  the  arid  system  for 
temperature  rise  printouts  and/or  plotting.  Using  IPRT  codes,  as  shown 
in  Table  2,  the  user  specifies  the  output  sections  desired.  For  multiple- 
pulse  exposures,  temperature  rises  are  printed  only  for  the  first  pulse 


TABLE  2.  PROGRAM  OUTPUT  SECTIONS 


Code 

Section 

IPRT(l) 

Grid  information 

IPRT (2) 

Laser  profile 

I PRT ( 3 ) 

Data  identification 

IPRT ( 4 ) 

Blood  flow  and  heat  deposition 

IPRT(5) 

Temperature  rises 

IPRT(6) 

Normalized  temperature  rises 

IPRT ( 7 ) 

Normalized  temperature  rises  of 
melanin  granules 

IPRT (8 ) 

Predicted  threshold  laser  power 

I PRT (9 ) 

Axial  extent  of  damage 

IPRT (10) 

Radial  extent  of  damage 

incident  on  the  retina;  however,  prediction  of  damage  is  based  on  multiple- 
pulse  effects.  The  range  of  grid  locations  at  which  temperature  rise  cal- 
culations are  printed  is  determined  from  ID1  and  ID2  for  the  axial  range, 
and  from  JD1  and  JD2  for  the  radial  range.  The  user  has  the  option  of 
printing  the  temperature  rises  at  all  the  time  intervals  determined  within 
the  model  (ITYPE=1),  onlv  every  nth  time  interval  (ITYPE=n),  and/or  at  any 
selected  times  (KTYPE0=1)  within  the  maximum  time  used  by  the  model.  The 
total  number  of  selected  times  for  printing  is  equal  to  KTYPE,  while  the 
selected  times  for  printinq  are  specified  in  TIMEX.  Temnerature  rise  cal- 
culations are  always  printed  at  the  beginning  and  end  of  the  pulse  and  at 
the  time  interval  TIME.  When  plots  of  temperature  rises  at  selected  times 
are  desired  (KTYPE0=0),  the  model  will  always  provide  printouts  in  addi- 
tion to  the  plots.  The  range  of  axial  and  radial  grid  locations  desired 
for  plots  is  determined  by  III,  112,  and  JJ1 , J32,  respectively.  1 13 
enables  the  user  to  mark  (by  an  asterisk)  a specific  axial  depth  on  plots 
for  easy  identification  and  comparison  with  other  plots. 


Tables  3 and  4 provide  a quick  reference  to  the  parameters  reauired 
as  input  to  the  model  as  well  as  their  required  formats  and  order.  Data 
cards  with  an  asterisk  as  a prefix  to  the  data  card  number  should  be 
checked  to  ensure  they  simulate  the  desired  exposure;  data  cards  withou  the 
prefix  asterisk  generally  remain  constant  from  exposure  to  exposure.  Data 
cards  with  an  asterisk  as  a suffix  to  the  data  card  number  are  not  input 
unless  an  irregular  profile  (IPR0F=2)  or  the  spread  function  (IFIL=1)  is 
used.  When  the  uniform  and  gaussian  profiles  are  used  (IPR0F=0,1),  data 
cards  20,  21,  and  22  are  not  input.  When  the  spread  function  is  not  used 
(IFIL=0),  data  cards  23,  24,  and  25  are  not  input. 
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TABLE  3.  INPUT  DECK  FOR  RE1 


Data  card 
number 

1 (4  cards) 


*2 

(1 

cardi 

*3 

1 

card 

*4 

1 

card 

*5 

(1 

card 

*6 

(1 

card 

*7 

(1 

card 

*8 

(1 

cardi 

*9 

,1 

card 

*10 

1 

card 

11 

1 

card 

*12 

[1 

card 

*13 

[1 

card) 

14 

,1 

card) 

15 

1 

card) 

16 

4 

cards 

17 

4 

cards 

18 

4 

cards 

19. ( 

1 

card) 

*20*  ( 

1 

card) 

*21*(l-3  cards) 
*22* (1-3  cards) 
*23* (1  card) 

24* (4  cards) 
25* (3  cards) 

26  (1  card) 

*27  (1  card) 

*28  (1  card) 

*29  (1  card) 

*30  (1  card) 

31  (l  card) 

32  (22  cards) 

33  (1  card) 


Format 

11F7.2 

1017 

F7 .4,317 

F7.2.2I7.F7.2 

I7.3E7.2 

10E7.2 

1017 

10E7.2 

1017 

1017 

11F7.2 

11F7.2 

11F7.2 

11F7.2 

11F7.2 

1017 

10F7.3 

1017 

10E8.3 

17 

10E7.3 

10E7.3 

10E8.3 

10F8.5 

10F8.5 

10F7.3 

I7.3E7.2 

I7.3E7.2 

10E7.2 

1017 

I7.3E7.2 

10F7.3 

11F7.2 


Parameter 

FTIME(L)  L*1 ,38 

IPRT(I)  1=1,10 

RIM,  LIM,  IFIL,  IGX 

RMAX,  UMAX,  MAXPRT,  LESION 

I PROF,  POW,  CUT 

DPULSE 

NTEST,  NRUN(L)  L=1 , NTEST 
REPET(L)  L=1 , NTEST 
NPULSE(L)  L=1 , NTEST 
ID1,  ID2,  JD1,  JD2,  ITYPE 
TO,  EDT1 , EDT2 

TOM,  APE,  AVL,  ACH,  ASC,  ATS,  RCO, 
RRT,  RSC,  RPE,  WAVEL 
TAV,  TPE,  TVL,  TCH,  TSC,  RVL 
CONX(L)  L-1,6 
VSHX(L)  L*1 ,6 
NPT(L)  L-1,38 
XCT(L)  L=1 ,38 
KTT(L)  L=1 ,38 
PUPIL 
LR 

RX(L)  L=1 ,LR 
PX(L)  L=1  ,LR 

ZO,  FLO,  FC,  NB,  CABER,  PP,  PC 

JO(L)  L=1 ,32 

NA(L)  L=1 ,22 

SHB,  XFLOW,  CFLOM 

KTYPEO 

KTYPE 

TIMEX(K)  K=l, KTYPE 
III,  I 12 , I I 3 , JJ1,  JJ2 
LTMAX 

TS(L)  L=1 , LTMAX,  10 
DAMAGE  (L2,l ) l ,2  , ? 

DAMAGE(L2,2)  J ^ 1 
TSTEAM,  DTSTM 


; Prefix  * indicates  parameters  most  often  altered  for  specific  exposures. 

$ 

Suffix  * indicates  parameters  not  input  unless  irregular  profile  or  spread 
function  is  used. 
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TABLE  4.  INPUT  DECK  FOR  RE2 


'"30  Same  as  RE1  Same  as  RE1 

31(1  card)  11F7.2  DAMAGE(L2,1)  ( , 

DAMAGE (L2, 2)  } L2=1*2 


I 

i 


OUTPUT  FORMAT 

The  printed  output  of  the  retinal  models,  RE1  and  RE2,  are  arranqed 
into  11  sections.  The  printout  format  and  the  IPRT  codes  for  each  section 
are  listed  in  Table  5.  The  user  has  the  option  of  printing  only  the  sec- 
tions desired,  as  specified  in  Table  2,  except  for  one.  The  unlabeled 
section  listed  prior  to  Predicted  Threshold  Laser  Power  on  Table  5 is 
always  printed.  (The  definitions  for  the  program  parameters  are  given  in 
Appendix  A.)  Not  every  parameter  in  Table  5 will  be  printed  every  time. 

In  the  Laser  Profile  Section,  if  the  spread  function  is  not  used,  all  para- 
meters dealing  with  it  will  not  be  printed.  On  the  first  line  of  this  sec- 
tion, only  RIM  is  printed  for  a uniform  beam  (IPR0F=0),  SIGMA,  RIM,  and 
CUT  for  a gaussian  beam  (IPR0F=1);  or  RINT  for  an  irregular  beam  (IPR0F*2). 
For  a single-pulse  exposure  (N=l),  trainlength  and  repetition  rate  are 
deleted  from  the  unlabeled  section. 

In  the  Temperature  Rises  section  (Table  5),  numbers  printed  at  each 
axial  and  radial  grid  point  represent  the  temperature  rise  (°C)  above  the 
initial  temperature  of  the  eye  (TO)  at  the  time  indicated.  For  the  Normal- 
ized Temperature  Rises  section,  the  temperature  rise  (°C)  is  divided  by  the 
input  power.  Therefore,  the  numbers  printed  at  each  grid  noint  represent 
the  temperature  rise  per  watt  of  input  power.  For  pulses  of  less  than  a 
3xl0"9-sec  duration,  POW  is  converted  to  a power  relative  to  a 3xlQ-9-sec 
pulse;  the  converted  POW  is  used  to  normalize  the  temperature  rises. 

For  the  axial  and  radial  extent  of  damage,  the  model  selects  the 
appropriate  statement  from  those  listed  in  Table  5.  If  the  Input  nower  pro- 
duces no  damage  within  the  grid  range  specified  by  LIMAX,  the  model  will 
print  NO  DAMAGE— LASER  POWER  TOO  LOW.  If  the  grid  range  specified  by  LIMAX 
contains  the  most  anterior  point  at  which  damage  occurs,  the  model  will 
print  MINIMUM  OEPTH  OF  DAMAGE  = (the  value  qiven  will  be  relative  to  the 
anterior  boundary  of  the  pigment  epitheJium).  If  the  maximum  posterior 
point  at  which  damage  occurs  is  contained  within  the  grid  range  specified 
by  LIMAX,  the  model  will  print  MAXIMUM  DEPTH  OF  DAMAGE  = (again,  the  value 
given  will  be  relative  to  the  anterior  boundary  of  the  pigment  epithelium). 
If  damage  is  present,  the  radial  extent  of  damage  will  be  printed  for  each 
axial  grid  point  specified  by  LIMAX.  The  value  for  the  radial  extent  of 
damage  will  be  relative  to  the  center  of  the  laser  beam. 
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TABLE  5.  PRINTED  OUTPUT  FOR  RE1 


GRID  INFORMATION  IPRT(l) 


R2  = 

R1  = 

ZM  * 

IDl  = 

ID2  = 

JD1  * 

JD2  = 

DR  = 

DZ  » 

IPA  = 

IPC  = 

IPE  * 

IPS  * 

LPA  = 

LPC  = 

LPE  = 

LPS  * 

M = 

Ml  * 

N = 

HI  * 

R = 

Z = 

ZH  = 

LASER  PROFILE 

I PRT ( 2 ) 

SIGMA  = 

RIM  = 

CUT  ■ 

RINT  = 

ZO  = 

FLO  = 

CABER  * 

CABER2  « 

PP  = 

PC  = 

NB  = 

NC  * 

FC  = 

WAVEL  - 

QP  = 

HR  = 

DATA  IDENTIFICATION  IPRT(3) 

REPET  * 

NPULSE  = 

AAV  = 

ACH  = 

APE  * 

ASC  - 

RCO  = 

RP.T  « 

RPE  = 

TOM  * 

TAV  » 

TCH  * 

TPE  = 

TSC  * 

IGX  * 

IFIL  = 

I PROF  * 

LIM  * 

POW  » 

DPULSE  = 

RIM  * 

RMAX  * 

CFLOW  =■ 

xflow  * 

SHB  * 

EDT1  * 

OT  ■ 

KM  = 

KT  « 

PTIME  = 

IKX  * 

AP  = 

APE1  = 

APE2  * 

RVL  * 

PUPIL  = 

TO  - 

LIMAX  * 

BLOOD  FLOW  AND  HEAT  DEPOSITION  IPRT(4) 

FLOW  I * 
FLOWX  * 
S » 


IPT  = 
LPV  * 


ATS  = 
AVL  * 
TVL  * 
NTEST  = 
TIME  = 
EDT2  = 
XC  « 

IG  = 
MAXPRT 


TABLE  5.  (Continued) 


TEMPERATURE  RISES  IPRT(5) 

TIME  * K = 

R * 

Z = 

Z = 


z = 

NORMALIZED  TEMPERATURE  RISES  IPRT(6) 

TIME  = K = POWER  = O.IOOOE+Ol  WATTS 

R = 

Z = 

Z = 


Z = 

NORMALIZED  TEMPERATURE  RISES  OF  MELANIN  GRANULES  IPRT(7) 

LTflAX  = BT  = 

XPO  = 


(unlabeled  section) 

WAVELENGTH  = DAMAGE  = 

NRUN  = TRAINLENGTH  = SEC  PULSE  WIDTH  = SEC 

NUMBER  OF  PULSES  = REPETITION  RATE  = PULSES/SEC 

IMAGE  RADIUS  = LESION  RADIUS  = CM 


TABLE  5.  (Continued) 


TEMPERATURE  RISES  AT  SELECTED  TIMES  TIMEX(K) 
TIME  = 


Z - 


Z = 

AXIAL  EXTENT  OF  DAMAGE  IPRT(9) 

NO  DAMAGE— LASER  POWER  TOO  LOW 
or 

DEPTHS  OF  DAMAGE  BEYOND  BOTH  SPECIFIED  DEPTHS 
or 

MINIMUM  DEPTH  OF  DAMAGE  = CM 
and/or 

MAXIMUM  DEPTH  OF  DAMAGE  = CM 
RADIAL  EXTENT  OF  DAMAGE  IPRT(IO) 

Z = CM  RADIAL  EXTENT  OF  DAMAGE  GREATER  THAN  CM 
or 

Z = CM  RADIAL  EXTENT  OF  IRREVERSIBLE  DAMAGE  = CM 


r 
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APPENDIX  A 


GLOSSARY 

All  parameters  used  as  either  input  or  output  in  the  retinal  models, 
and  some  used  internally,  are  listed  in  alphabetical  order,  with  appro- 
priate units  and  suggested  input  values.  The  equations  provided  are  in 
FORTRAN  IV  language,  where  ALOG  represents  the  natural  logarithm  and  ** 
represents  "raised  to  the  power."  For  some  of  the  parameters,  numerical 
values  are  tabulated  in  the  tables  at  the  end  of  the  glossary. 

AAV~The  absorption  coefficient  for  the  ocular  media  from  the  cornea  to 
the  retina. 

Units:  inverse  cm 

AAV  = ALOG ( TOM )/TAV 

ACH— The  absorption  coefficient  for  the  choroid. 

Units:  inverse  cm 

Suggested  input  value:  Tables  A-l  and  A-2 

AP_— The  fraction  of  heat  that,  deposited  in  the  granulated  pigment  epi- 
thelium, is  absorbed  by  the  melanin  granules.  AP  is  calculated  from 
ACH,  RPE,  TPE,  APE1 , and  APE2.  It  is  printed  and  used  only  when  the 
subroutine  MXGRAN  in  RE1  is  used. 

Units:  unitless 

APE— The  absorption  coefficient  of  the  pigment  epithelium. 

Units:  inverse  cm 

Suggested  input  value:  Tables  A-l  and  A-2 

APE1— The  absorption  coefficient  for  the  anterior  sublayer  of  the  piqment 
epithelium. 

Units:  inverse  cm 

APE1  = (APE-ACH*(1 . — RPE ) ) /RPE  for  IGX=0 
APE1  = ACH  for  IGX=1 

APE2— The  absorption  coefficient  of  the  posterior  sublayer  of  the  pigment 
epithelium. 

Units:  inverse  cm 

APE2  = ACH  for  IGX=0 

APE2  =■  (APE-ACH*RPE)/(1  .-RPE)  for  IGX=1 
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ASC--The  absorption  coefficient  for  the  sclera. 

Units:  inverse  cm 

Suggested  innut  value;  same  as  ACH 

ATS— The  absorption  coefficient  for  the  tissue  posterior  to  the  sclera 
of  the  eye. 

Units:  inverse  cm 

Suggested  input  value:  same  as  ACH 

AVL— The  absorption  coefficient  for  the  choriocapi Haris  (vascular  layer). 

Units:  inverse  cm 

Suggested  inout  value;  same  as  ACH 

BT— The  time  interval  durinq  which  heat  conduction  from  the  qranules  is 
insianificant.  It  is  the  time  interval  used  to  evaluate  the  contri- 
butions of  the  melanin  qranules  to  the  temperature  rises.  8T  is  set 
equal  to  0.3x10-8. 

Units:  sec 

CABER--A  constant  in  the  spherical  aberration  term  used  in  the  spread 
function.  The  spherical  aberration  term  is  CABER  pVX,  where  p 
is  the  radius  in  the  pupil  plane  and  A is  the  wavelenath.  CABER  is 
printed  only  when  the  spread  function  is  used  (IFIL=1). 

Units:  cm- 4.  nm 

Suogested  input  value:  -3.0E+6 

CABER2— A spherical  aberratiqn  constant  calculated  by  dividing  CABER  bv 
the  wavelength  (nm)  of  the  incident  radiation.  CABER2  is  printed 
only  when  the  spread  function  is  used  (IFIL=1). 

Units:  cm”^ 

CFLO'.-I— The  total  blood  flow  to  the  choriocapillaris. 

Units:  g.sec"1 

Suggested  innut  value:  0.024 

CJhX(L) ,L=1 .6 — The  thermal  conductivity  of  the  Lth  ocular  media  as  listed 
in  Table  1 (text). 

Units:  cal •cm-^ *sec"^ ‘0C"^ 

Suggested  input  value:  0.0012 


CUT--The  fraction  of  the  peak  intensity  in  the  beam  cross-sectional  dis- 
tribution at  which  the  beam  radius,  RIM,  is  specified  for  naussian 
profiles  (IPR0F=1).  CUT  can  be  any  fraction  of  the  peak  intensity, 
but  RIM  must  be  specified  at  the  same  point. 


Units:  unitless 

Suggested  input  value: 


DAMAGE 


DAMAGE 


1.35E-1  (1/e^  intensity  ooints  of  a naussian 
profile) 

, 'L2=l  ,2)— The  DAMAGE  array  contains  the  co- 


efficients  for  the  damage-rate  integral. 

For  temperatures  below  59°C: 

Rate  = EXP  ( DAMAGE (1 ,1 ) - DAMAGE (1 ,2)/(VC+273+TQ) ) . 

For  temperatures  above  50°C: 

Rate  = EXP  ( DAMAGE ( 2 , 1 ) - DAMAGE ( 2,2 )/(VC+273+T0) ) . 

VC  is  the  temperature  rise  (°C)  at  the  specified  qrid  ooints.  TO  is 
the  initial  temperature  (°C)  of  the  eve,  and  the  number  273  converts 
degrees  Celsius  to  Kelvin.  The  values  provided  are  for  skin  tissue; 
but  they  are  assumed  to  equate  to  the  damage-rate  constants  for  ret- 
inal tissue. 

Units:  DAMAGE (L2,l ):  unitless 

DAMAGE(L2,2):  sec"1 

Suggested  input  values:  DAMAGE (1,1)  149. 

DAMAGE (1,2)  = 50,000. 

DAMAGE (2,1)  = 242. 

DAMAGE (2, 2)  = 80,000. 

DPULSE— The  exposure  duration  of  an  individual  pulse. 

Units:  sec 

Suggested  input  value:  3.0E-9  to  1.0E+3 

DR_--The  radial  increment  in  the  uniform  portion  of  the  qrid  network. 

Units:  cm 

OR  = LESI0N/LIM  for  gaussian  and  irregular  beam  profiles  ( I PR0F=1 , 2 ) 
DR  = RIM/(LIM-.5)  for  uniform  profiles  (IPROF=0) 

NOTE:  For  IFIL=1,  since  RIM  is  a corneal  dimension,  LIM  must  be 

large  to  obtain  a small  DR. 

OT--The  initial  time  interval  after  the  start  of  a pulse  at  which  tempera- 
ture rise  calculations  are  made.  Successive  calculated  time  inter- 
vals are  increased  by  the  stretchinn  factor  XC. 

Units:  sec 


l)T  = D PULSE  * (XC-1.)/(XC**NP-1.) 

NP  = NPT(Ll)  for  single  pulse 
XC  = XCT(Ll)  for  single  pulse 
LI  = ALOG(DPULSE)/ .6931 5 + 29. 

NP  = 5 for  multiple  pulse 
XC  = 1.4  for  multiple  pulse 

DTSTM--The  temperature  increment  used  to  increase  TSTEAM  in  calculating 
the  power  required  to  produce  the  temperature  TSTEAM  in  the  melanin 
granules.  Successive  calculations  and  printouts  of  Predicted  Thresh- 
old Power  will  be  made  at  each  increment  of  TSTEAM  until  the  power 
required  to  produce  the  temperature  TSTEAM  exceeds  the  Dower  required 
to  produce  irreversible  damage  as  predicted  by  the  damage  integral 
method.  Reducing  DTSTM  results  in  increased  computation  time  and 
printout. 

Units:  °C 

Suggested  input  value:  200. 

DZ— The  axial  increment  in  the  uniform  portion  of  the  grid  network. 

Units:  cm 

DZ  = TPE/M1  - l.E-25 
Ml  = 6 

EDT1,  EDT2— Parameters  used  to  determine  the  time  intervals  at  which  tem- 
perature rises  are  calculated.  The  model  divides  the  computed  time 
interval  into  2*IKX  subintervals  to  insure  stability  and  accuracy. 

IKX  is  dependent  upon  TIME,  EDT1 , and  EDT2.  The  suggested  values 
are  adequate  except  for  pulse  widths  greater  than  10^  sec. 

Units:  unitless 

Suggested  input  values:  EDT1  = 0.16;  EDT2  = 1. 

IKX  = TIME**EDT1  + EDT2 


FC—The  focal  length  of  the  cornea  measured  in  the  ocular  media.  PC  is 
required  onlv  when  the  spread  function  is  used  (IFIL=1). 

Units:  cm 

Suggested  input  value:  3. 12EU— humans 

2. 43E0— rhesus  monkevs 

FLO— The  second  principal  focal  length  at  a 500-nm  wavelenoth.  The  sec- 
ond principal  focal  point  is  the  ooint  at  which  parallel  light  in- 
cident upon  the  anterior  portion  of  the  eye  will  focus.  FLO  is  re- 
quired only  when  the  snread  function  is  used  (IFIL=1). 

Units:  cm 

Suggested  input  value:  2.242t0--humans 

T . 684F; — **hesus  "onkevs 
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FLOWI(J).  J=1  .JVL— The  flow  of  blood  into  a unit  volume  of  the  chorio- 
capil laris  at  some  radial  point,  R(J).  JVL  is  the  index  such  th 
R(JVL)=RVL. 


that 


Units:  g*cm“3*sec"^ 


FLQWX(J),  J=1 .JVL—' The  product  of  the  radius  at  some  radial  point,  R(J), 
ana  the  net  flow  of  blood  per  unit  area  in  the  radial  direction  at 
point  R(J).  JVL  is  the  index  such  that  R( JVL ) =RVL . 

Units:  g*cirH*sec-^ 

FUME (L ) , L=1 ,38— The  array  FTIME  is  used  for  multiple-pulse  exposures  to 
determine  the  time  interval  (TIME)  over  which  the  damaqe  integral  is 
evaluated.  TIME  is  a function  of  FTIME;  each  element  of  FTIME  is 
associated  with  a ranqe  of  pulse  widths  (DPULSE). 

Units:  unitless 

Suggested  input  value:  1.8  for  all  elements 

TIME  = FT IME (LI ) * XI  for  multiple  pulse 
LI  = AL0G( DPULSE)/. 6931 5 + 29. 

XI  = NPULSE(L)/REPET(L)  The  largest  value  for  anv  NTEST . 

Therefore,  to  increase  the  time  interval  (TIME)  over  which  the 
damaqe  integral  is  evaluated,  one  should  increase  the  Lth  element  of 
FTIME  associated  with  the  specified  pulse  width  (DPULSE). 


HR( J ) , J=1 ,N--The  normalized  retinal  irradiance  at  radial  position  R(J). 
Symmetry  about  the  axis  is  assumed. 

Units:  unitless 

IDl,  102— Input  and  output  parameters.  As  input  parameters,  ID1  and  ID2 
are  integers  used  to  determine  at  what  axial  positions  the  tempera- 
ture rises  are  to  be  printed.  The  temperature  rises  will  be  printed 
at  axial  positions  with  indexes  from  I=IPE+ID1  to  I=IPE+ID2.  As 
output  parameters,  IDl  and  ID2  are  actual  qri  index  points  relative 
to  the  first  grid  point  located  anterior  to  the  cornea.  Temperature 
rises  are  to  be  printed  from  grid  point  IDl  to  point  ID2. 

Units:  unitless 

Suggested  input  values:  dependent  upon  the  user 

IDl  (output)  = IPE  + IDl  (input) 

ID2  (output)  = IPE  + ID2  (input) 
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I F I L — The  parameter  that  allows  the  user  to  decide  whether  or  not  to  use 
the  spread  function.  The  spread  function  is  used  to  transfer  the 
beam  distribution  from  the  cornea  throuqh  the  ocular  media  to  the 
retina.  When  the  spread  function  is  used,  all  input  (RIM,  POW,  CUT 
RX(L),  PX(L),  LR,  ZO)  beam  characteristics  must  apply  to  the  bean 
at  the  cornea.  When  the  spread  function  is  not  used,  the  input 
spatial  beam  characteristics  are  assumed  to  apply  to  the  beam  dis- 
tribution at  the  retina,  with  the  exception  of  POW  and  PX(L)  which 
alwavs  apply  to  the  cornea. 

Units:  unitless 

Suqqested  input  value:  1—  spread  function  is  used. 

0--spread  function  is  not’ used. 

]G--The  index  of  the  initial  nrid  point  in  the  melanin  granules.  It  is 
used  and  printed  only  in  program  RE1 . 

Jnits:  unitless 

IGX--The  selection  parameter  for  the  absorption  coefficients  of  the  two 
sublayers  modeled  in  the  pigment  epithelium.  For  IGX=1 , the  absorp 
tion  coefficient  for  the  anterior  sublayer  (APE!)  is  equal  to  ACH. 
The  absorption  coefficient  for  the  posterior  sublayer  (APE2)  is  com 
outed  assuminq  it  contains  most  of  the  melanin  aranules.  For  IGX=0 
APE2=ACH  and  APE1  is  computed  assuminq  the  anterior  sublaver  con- 
tains most  of  the  melanin  qranules. 

Units:  unitless 

Suqqested  input  value:  1 — a human  eye 

0— a monkey  eye 

III,  1 1 2— The  indexes  used  to  specify  the  ranqe  of  axial  grid  values 
desired  for  a plot.  These  indexes  are  the  actual  indexes  of  grid 
points,  with  III  closer  to  the  anterior  part  of  the  eye. 

Units:  unitless 

Suggested  input  values:  dependent  unon  the  user 

1 13 — An  identification  index  used  in  the  plotting  routine.  An  asterisk 
can  be  placed  on  the  curve  at  the  axial  deoth  associated  with  grid 
point  1 13  in  a plot  and  allows  easy  reference  for  comnarinn  similar 
curves  in  more  than  one  plot.  1 1 3 is  the  index  of  an  actual  nrid 
poi nt. 

Units:  unitless 

Suggested  input  value:  dependent  upon  the  user 


IKX— The  number  of  times  the  temperature  calculations  are  repeated  to  in 
sure  stability. 


Units:  unitless 

IKX  = TIME  **EDT1  + EDT2 

TIME  = FT IME ( LI )*X1  for  multiple  nulse 

LI  = ALOG  (DPULSE)/. 69315  + 29. 

XI  = NPULSE/REPET  the  larqest  value  for  any  NTEST 
TIME  = OT  * (XC  **KT  -l.)/(XC-l.)  for  sinnle  pulses 
KT  = KTT(Ll) 

XC  = XCT(Ll) 

I PA— The  index  of  the  initial  grid  point  located  in  the  cornea.  Its  value 
is  always  2. 

Units:  unitless 

I PC — The  index  of  the  initial  grid  point  in  the  choroid. 

Units:  unitless 

I PE — The  index  of  the  initial  grid  point  in  the  pigment  epithelium.  Its 
current  value  is  10. 

Units:  unitless 

IPRQF— The  parameter  used  to  describe  the  laser  intensity  profile.  If  a 
uniform  profile  is  specified,  RIM  and  POW  must  be  specified.  For 
a gaussian  profile,  RIM,  CUT,  and  POW  must  be  given.  Irregular 
profiles  require  PX(L),  RX(L),  Lk,  and  POW. 

Units:  unitless 

Suggested  input  value:  0 — uniform  profile 

1—  qaussian  profile 

2 —  irregular  profile 

IPRT ( I ) , 1=1 ,10 — The  parameter  which  gives  the  user  the  choice  of  printing 
or  not  printing  each  of  10  separate  output  sections  described  in 
text  Output  Format  section. 

Units:  unitless 

Suggested  input  value:  o— printing  is  not  desired. 

1—  printing  is  desired. 

IPS — The  index  of  the  initial  grid  point  in  the  sclera. 

Units:  unitless 
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I PT — The  Index  of  the  initial  grid  point  in  the  tissue  posterior  to  the 
sclera. 

Units:  unitless 

I PV — The  index  of  the  initial  grid  point  in  the  chorlocapillaris. 

Units:  unitless 

ITYPE— Used  to  determine  the  time  indexes  (K)  at  which  the  temperature 
rises  will  be  printed.  The  total  number  of  times  the  temperature 
rise  calculations  can  be  printed  is  equal  to  KT.  If  the  tempera- 
ture rises  are  to  be  printed  at  all  times  (XT(K)  K*2,KT),  ITYPE  must 
equal  one.  If  temperature  rises  are  to  be  printed  at  every  nth  time, 
ITYPE  must  equal  n.  Temperature  rise  printouts  will  always  be  pro- 
vided at  the  first  time  (K=2)  after  initiation  of  the  pulse,  at  the 
conclusion  of  the  pulse  (K=KM),  and  at  the  final  time  over  which 
damage  is  assessed  (TIME=XT(KT)).  ITYPE  must  never  equal  zero. 

Units:  unitless 

Suggested  input  value:  deoendent  upon  the  user 

JD1 , JD2— The  radial  indexes  used  to  determine  the  radial  positions  from 
the  center  of  the  laser  beam  at  which  the  temperature  rises  are  to 
be  printed.  The  model  will  print  the  temperature  rises  starting  at 
radial  position  JD1,  out  to  radial  position  JD2.  JD1=1  corresponds 
to  the  z-axis  or  the  center  of  the  beam.  All  14  radial  grid  points 
can  be  printed;  but  only  9 will  be  printed  on  a single  line,  with 
the  other  5 printed  in  consecutive  order  on  the  second  line. 

Units:  unitless 

Suggested  input  values:  deoendent  upon  the  user 

JJ1,  JJ2— The  indexes  of  arid  points  used  to  specify  the  range  of  radial 
grid  values  desired  for  a plot.  JJ1  is  the  index  closer  to  the 
center  of  the  beam. 

Units:  unitless 

Suggested  input  values:  JJ1  =1,  and  JJ2  = 5 

J0(L),  L=l,32— The  value  of  the  zero-order  Bessel  function  for  argument 
values  to  3.1  in  0.1  increments.  It  is  used  in  constructing  the 
spread  function. 

Units:  unitless 

Suggested  input  values;  Table  A-6 

K~  An  index  of  the  expanded  times,  XT(K)— times  at  which  temperature  rise 
calculations  are  made. 
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KM— The  index  indicating  the  temperature  rise  printout  occurring  at  the 
“ end  of  the  pulse  (XT(KM)=DPULSE) . 

Units:  unitless 

KT— The  maximum  number  of  times  at  which  temperature  rise  calculations 
are  comouted. 

Units:  unitless 

XT(KT)  = TIME 

KT  = KTT(Ll)  for  sinqle  pulse 
LI  = ALOG(DPULSE)/. 69315  + 29. 

KT  = [AL0G(1.+TIME*(XC-1.)/DT)/AL0G(XC)+1.]+1  for  multiple  nulses 

KTT(L)  L»1 .38— An  array  of  the  number  of  steps  used  to  reach  the  total 
time  (TIME).  The  suggested  values  were  calculated  to  reduce  error 
and  increase  stability  in  solving  the  finite-difference  equations 
in  the  model . 

Units:  unitless 

Suggested  input  values:  Table  A-4 

KTYPE--The  total  number  of  temperature  rise  nlots  or  selected  time  nrint- 
outs  desired.  If  no  plots  or  selected  time  printouts  are  desired, 
set  KTYPE=0.  KTYPE  has  a maximum  value  of  10.  A printout  of  the 
temperature  rise  is  automatic  with  each  requested  plot. 

Units:  unitless 

Suggested  input  value:  dependent  upon  the  user 


KTYPEO— The  parameter  that  controls  the  punchinq  of  data  cards  used  as 
input  to  the  plot  routine. 

Units:  unitless 

Suggested  input  value:  0— card  punching 

1— no  card  punching 

LESION— The  radius  of  the  retinal  lesion.  It  is  used  only  to  determine 
5r  for  efficient  qrid  structuring.  It  is  not  used  for  uniform  beam 
profiles  (IPR0F=0). 

Units:  cm 

Suggested  input  value:  dependent  upon  the  user 

DP  = LESION/LIM  for  gaussian  and  irregular  beam  profiles  (IPR0F=1  or  2). 
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LIM—The  number  of  radial  intervals  from  the  center  of  the  beam  to  RIM 
for  uniform  beam  profiles  (IPROF-O),  or  to  LESION  for  gaussian  and 
irregular  profiles  ( IPROF-1  or  2).  LIM  is  used  to  determine  the 
size  of  the  smallest  uniform  radial-grid  increment  (DR).  There  are 
only  four  uniform  radial-grid  intervals. 

Units:  unitless 

Suggested  input  value:  5 

LI MAX- -A  parameter  that  determines  the  ranoe  of  axial  distances  at  which 
damage  calculations  are  printed.  It  is  used  in  conjunction  with 
MAXPRT.  For  single-pulse  exoosures,  LIMAX  has  a maximum  value  of 
9 for  MAXPRT=2  or  3,  and  a maximum  value  of  4 for  MAXPRT=1 . For 
multiple-pulse  exposures,  LIMAX  has  a maximum  value  of  2 reoardless 
of  MAXPRT. 

Tor  MAXPRT  = 1,  axial  distance  = IMAX  - 2 LIMAX  to  IMAX 

MAXPRT  = 2,  axial  distance  = IMAX  + LIMAX 

MAXPRT  = 3,  axial  distance  = IMAX  to  IMAX  + 2 LIMAX 

IMAX  = the  axial  orid  point  at  which  peak  temperature  rises  occur  at 

the  conclusion  of  the  Dulse. 

Units:  unitless 

Suggested  input  value:  dependent  upon  the  user 

LPA— The  index  of  the  last  grid  point  located  in  the  vitreous  humor. 
Units:  unitless 

LPC--The  index  of  the  last  grid  point  in  the  choroid. 

Units:  unitless 

LPE— The  index  of  the  last  grid  point  in  the  pigment  epithelium. 

Units:  unitless 

LPS--The  index  of  the  last  grid  noint  in  the  sclera. 

Units:  unitless 

LPV--The  index  of  the  last  grid  noint  in  the  choriocapillaris. 

Units:  unitless 

LIR— The  total  number  of  profile  values  to  be  specified  (LR  has  a maximum 
value  of  30).  For  irregular  beam  (IPR0F=2)  distributions  only,  the 
user  must  specify  the  intensity  distribution  of  the  beam  on  a noint- 
by-point  basis  bv  givino  the  profile  irradiance  value,  PX(L),  and 
associated  radial  distances,  RX(L). 

Units:  unitless 

Suncested  input  value:  dependent  upon  the  user 
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LTMAX-- The  parameter  that  controls  the  tine  bevond  which  the  temnerature 
rises  of  the  melanin  granules  are  completely  dissinated.  LTb*AX 
must  be  large  enough  to  allow  the  temoerature  rises  in  the  melanin 
granules  to  decrease  to  an  insignificant  value.  The  suggested  value 
has  been  found  to  be  adequate,  and  it  is  recommended  that  LTMAX 
not  be  less  than  2191 . 

Units:  unitless 

Suggested  input  value:  2191 

M--The  total  numbey-  of  grid  spaces  in  the  axial  direction,  an  even  integer; 
currently,  M = 28. 

Units:  unitless 

— Hal f the  number  of  uniformly  spaced  axial  increments;  currently  Ml  = 6. 
Units:  unitless 

MAXPRT— The  parameter  which  gives  the  user  the  option  to  control  the  print- 
ing of  the  predicted  threshold  laser  powers  and  extent  of  damane. 

If  MAXPRT  eguals  1,  predicted  threshold  laser  power  calculations  will 
be  printed  only  at  axial  positions  anterior  to  the  position  o^  the 
peak  temperature  rise,  IHAX(  ITdAX-2  UMAX  to  I MAX) . If  MAXPRT  equals 
2,  the  printouts  will  be  for  axial  positions  both  anterior  and 
posterior  to  the  peak  temperature  rise  position  (1NAX-LIMAX  to  IMAX 
+ UMAX).  If  MAXPRT  eguals  3,  printouts  will  be  made  onlv  for  axial 
positions  posterior  to  IMAX  (IMAX  to  IMAX  + 2*  UMAX). 

Units:  unitless 

Suggested  input  value:  1— anterior  side  of  peak  temoerature 

2—  both  sides  of  neak  temperature 

3—  posterior  side  of  peak  temnerature 

N— The  total  number  of  grid  spaces  in  the  radial  direction;  currently, 

N=13. 


Units:  unitless 

Nl— The  number  of  uniform  grid  increments  in  the  radial  direction;  cur- 
rently N I *4 . 

Units:  unitless 

NA(L),  Lsl,22— The  refractive  index  of  the  ocular  media  as  a function  of 
wavelength.  They  should  be  placed  on  the  data  card  in  increasing 
wavelength  sequence  from  350  nm,  at  50-nm  increments. 

Units:  unitless 

Suggested  input  values:  Table  A-7  (for  water) 


NB—The  index  of  refraction  of  the  ocular  media  at  a 500-nm  wavelength. 

NB  is  required  only  if  the  spread  function  is  used  (IFIL*1). 

Units:  unitless 

Suggested  input  value:  1 ,336E(J (mainly  for  water) 

NC— The  index  of  refraction  of  the  ocular  media  for  wavelenqth  (WAVEL). 

NC  is  printed  onlv  if  the  spread  function  is  used  (IFIL=1). 

Units:  unitless 

NP— Constant  used  within  the  program. 

Units:  unitless 

NPT(L).  L=l,38— The  number  of  incremental  times  used  to  subdivide  DPULSE. 
It  is  associated  with  specific  values  of  FTIME(L) , XCT(L),  and 
KTT(l),  all  of  which  are  associated  with  a specific  ranqe  of  values 
of  DPULSE  and  DT.  The  suggested  values  were  calculated  to  keep  the 
errors  small  and  satisfy  stability  requirements  for  solvino  the 
heat-conduction  boundary  value  problem  through  the  use  of  finite 
differences. 

Units:  unitless 

Sugqested  inout  values:  Table  A-4 

NPULSE(L),  L=1 , NTEST— The  number  of  pulses  associated  with  a specified 
test  exposure  identified  by  NRUN(L).  All  other  parameters  except 
pulse  repetition  rate  must  remain  constant  for  all  NRUN(L). 

Units:  unitless 

Sugqested  input  values:  dependent  upon  the  user 

NTEST— The  number  of  test  exposures  run  which  differ  only  in  pulse  repe- 
tition rate  and/or  number  of  pulses.  All  other  parameters  must 
remain  fixed  from  test  exposure  to  test  exposure.  This  allows  re- 
ducing computation  time  if  only  the  Dulse  repetition  rate  and/or 
number  of  pulses  differ  from  run  to  run.  For  single-pulse  exposures, 
NTEST*1 . 

Ui.its:  unitless 

Suggested  input  value:  dependent  upon  the  user,  MAX  * 7 

P£--The  distance  from  the  pupil  to  the  cornea.  PC  is  required  only  if 
the  spread  function  is  used  (IFIl=l). 

Units:  cm 

Suoqested  input  value:  4.0E-1  for  humans 

3.6E-1  for  rhesus  monkeys 
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POW— The  total  power  per  oulse  incident  on  the  corneal  surface;  assumed 
to  be  constant  during  the  exposure. 

Units:  watts 

Suqqested  input  value:  dependent  uDon  the  user 

PP— The  distance  between  the  pupil  and  the  second  nrincioal  focal  plane. 
It  is  required  only  when  the  spread  function  is  used  (IFIL=1). 

Units:  cm 

Suqqested  input  value:  1.35E-1  for  humans 

1.2E-1  for  rhesus  monkeys 

PTIME—The  uniform  time  increment  into  which  DPULSE  is  divided  for 

multiple-pulse  calculations.  For  single-pulse  exposures,  PTIME  is 
not  used. 

Units:  sec 

PTIME  = DPULSE/NP  for  multiple  oulses. 

NP  = 5. 


PUPIL— The  radius  of  the  pupil  of  the  eve. 

Units:  cm 

Sunqested  input  value:  3.5E-1 

PX(L) , L=1  ,LR— The  absolute  or  relative  irradiance  incident  on  the  cornea 
for  an  irregular  profile  at  the  radial  distance  from  the  center  of 
the  beam,  RX(L).  Symmetry  with  resoect  to  the  axis  is  assumed.  PX(L) 
cannot  have  a value  of  zero  at  the  center  axis  of  the  beam. 

Units:  watts *cm“2 

Suqqested  input  value:  dependent  upon  the  user 

^D— All  QO  values  in  program  RE2,  and  those  associated  with  the  last  two 
TSTEAM  values  in  program  RE1,  are  the  power  ner  oulse  at  the  speci- 
fied grid  points  required  to  cause  irreversible  damage  as  determined 
by  the  damaqe  integral.  The  other  QD  values  in  program  RE1  are  the 
powers  required  to  raise  the  temperature  to  TSTEAM.  QD  is  set  eoual 
to  1.0E+20  when  the  temperature  rise  is  less  than  10'3°c. 

Units:  watts 

QP—The  laser  Intensity  at  R(  1 ) , the  center  of  the  beam,  entering  the  eve 
after  the  corneal  reflection. 

Units:  cal *cm-2. sec-1 

P ( J ) , J»1 ,N+1  — The  radial  distance  measured  from  the  center  of  the  beam. 
Units:  cm 
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Rl— The  exponential  stretching  factor  in  the  axial  direction  for  the  non- 
uniform  part  of  the  grid  system. 

Units:  unitless 

R2— The  exponential  stretching  factor  in  the  radial  direction  for  the  non- 
uniform  part  of  the  grid  system. 

Units:  unitless 

RCQ— The  fraction  of  light  reflected  from  the  cornea. 

Units:  unitless 

Suggested  input  value:  Tables  A-l  and  A-2. 

REPET(L) , L=1 .NTEST — The  repetition  rate  associated  with  the  soecific  test 
exposure  identified  by  NRUN(L) . All  other  parameters  except  the 
number  of  Dulses  must  remain  constant  for  all  NTEST  runs.  For  a 
single  pulse  exnosure,  set  REPET ( L ) =1 . If  both  NPULSE  and  NTEST=1 , 
REPET  is  read  but  not  used  in  the  program. 

Units:  Hz 

Sugaested  inout  values:  deoendent  upon  the  user 


RIM— The  beam  radius  at  the  cornea  if  the  spread  function  is  used  (IFIL=1) 
or  at  the  retina  if  the  spread  function  is  not  used  (IFIL=0).  It  is 
specified  at  CUT  for  gaussian  profiles  (IPR0F=1).  Although  not  used 
for  irregular  profiles  (IPR0F*2),  a value  must  always  be  specified 
for  RIM.  For  uniform  profiles  (IPR0F=0),  it  is  used  with  LIM  to 
establish  the  minimum  radial  grid  increment  DR. 

Units:  cm 

Suggested  input  value:  dependent  upon  the  user 

RINT--A  radial  interval  used  in  the  input-profile  evaluation  and  in  the 
spread-function  integration.  It  is  only  printed  when  the  spread 
function  (IF IL=1 ) or  irregular  profile  (IPROF-2)  is  used. 

Units:  cm 

RINT  - PUPIL/ (LI-1 ) , LI =500 

RMAX— The  maximum  radial  distance  at  which  damaqe  assessments  are  to  be 
made.  The  model  assesses  damage  at  all  grid  points  from  R(J)=0 
to  the  first  qrid  point  beyond  R(J)=RMAX. 

Units:  cm 

Sungested  input  value:  0.001 
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RPE--A  fraction,  ranging  from  zero  to  one,  used  to  determine  the  thickness 
of  the  two  sublayers  of  the  pigment  epithelium.  RPE  is  used  in  con- 
junction with  IGX  to  determine  the  absorption  properties  (APE1  and 
APE2)  of  the  two  sublayers;  it  cannot  equal  IGX,  thus  avoiding  a divi- 
sion by  zero.  RPE  represents  the  fraction  of  the  total  thickness  of 
the  pigment  epithelium  (TPE)  occupied  by  the  anterior  sublayer. 

Units:  unitless 

Suggested  input  value:  0.— no  anterior  sublayer 

0.33 — monkey  eye 

0.67 — human  eye 

1 .0— no  posterior  sublayer 

RPE*TPE  = thickness  of  anterior  sublayer 
1-RPE*TPE  = thickness  of  posterior  sublayer 

RRT— The  fraction  of  light  reflected  from  the  retina. 

Units:  unitless 

Suggested  input  value:  Tables  A-l  and  A-2 

RSC— The  fraction  of  light  reflected  from  the  sclera. 

Units:  unitless 

Suggested  Input  value:  Tables  A-l  and  A-2 

RVL— The  radial  extent  of  the  eye;  the  boundary  where  no  temperature  rise 
occurs. 

Units:  cm 

Suggested  innut  value:  0.7 

RX(L).  L=1 |LR — The  radial  distance  from  the  center  of  the  beam,  that  is 
associated  v/ith  the  Drofile  irradiance  value,  PX(L),  for  irregular 
beam  profiles  (IPR0F*2). 

Units:  cm 

Suggested  input  values:  dependent  upon  the  user 

S_— ' The  rate  of  heat  deposition  from  the  incoming  beam  per  unit  volume 
at  axial  distances  Z ( I ) and  radial  distances  R(J).  The  S printout 
is  given  for  N radial  positions  on  one  line  for  each  axial  qrid 
point  except  those  at  the  boundaries. 

Units:  cal *cm"3*sec”l 

SHB— The  specific  heat  of  blood. 

Units:  cal •cm"^»°C“^ 

Suggested  input  value:  0.92 
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SIGMA- -The  radius  of  the  beam  at  the  ooint  where  the  intensity  is  l/e? 
of  the  maximum  value.  It  is  used  only  for  paussian  profiles 
( IPR0F=1 ) and  is  specified  at  the  cornea  if  the  spread  function  is 
used  ( I F I L=1 ) . If  the  spread  function  is  not  used  (IFIL=0),  all 
nrofile  values  are  considered  to  be  at  the  retina. 

Units:  cm 

TAV— The  thickness  of  the  ocular  media  from  the  cornea  to  the  vitreous 
humor  inclusive;  the  distance  from  the  cornea  to  the  retina. 

Units:  cm 

Suggested  input  value:  Table  A-3 

TCH--The  thickness  of  the  choroid. 


Uni ts : cm 

Suggested  input  value:  Table  A-3 

TIME— The  maximum  time  for  temperature  rise  calculations  and  damage- 
integral  evaluation. 

Units:  sec 

TIME  = DT*(XC**KT-1 . ) / ( XC- 1 . ) for  single  pulse 
DT=  DPULSE*( XC— 1 . )/(XC**NP-l . ) for  single  pulse 
KT  = KTT(Ll)  for  single  pulse 
NP  = NPT(Ll)  for  sinqle  pulse 
XC  = XCT(Ll)  for  sinnle  oulse 
LI  = ALOG(DPULSE)/. 69315  + 29. 

TIME  = FTIME(L1)*X1  for  multiple  pulse 

XI  = NPULSE/REPET  larqest  fraction  in  all  tests 

TIMEX(K),  K=1 tKTYPE— The  time  at  which  a plot  or  selected-time  printout 
of  the  temperature  rises  is  desired.  A separate  value  of  TIMEX(K) 
must  be  supplied  for  each  plot  or  selected-time  orintout.  All 
values  of  TIMEX(K)  must  be  less  than  or  eoual  to  the  total  tine 
over  which  damage  is  assessed  (TIME). 

Units:  sec 

Suggested  input  values:  dependent  upon  the  user 
T£--The  initial  temperature  of  the  eve. 

Units:  °C 

Suggested  input  value:  37. 

TOM— The  transmittance  of  the  ocular  media  from  the  anterior  surface  of 
the  cornea  to  the  pigment  epithelium. 

Units:  unitless 

Suggested  input  value:  Tables  A-i  and  A-2 
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TPE--The  thickness  of  the  piqment  epithelium. 


Units:  cm 

Suqqested  input  value:  Table  A-3 

TS(L) , L=1 .LTHAX.IO— The  normalized  temperature  rise  decavs  with  respect 
to  time  for  the  melanin  qranules.  They  are  normalized  to  the  nower 
required  to  raise  a homoqeneous  piqmented  layer  an  averaqe  of  1°C 
per  unit  volume  and  are  qiven  in  increments  of  10BT  or  3x10"^  sec. 
Values  in  Table  A-5  were  computed  for  melanin  qranules  1 um  wide 
with  a 1.5  um  separation  between  adjacent  nranules. 

Units:  °C 

Suqqested  input  values:  Table  A-5 
TSC— The  thickness  of  the  sclera. 

Units:  cm 

Suqqested  input  value:  Table  A-3 

TSTEAM--A  temperature  defined  by  the  user  accordinq  to  the  particular 
subject  beinq  studied.  The  model  computes  the  Dower  necessarv  to 
raise  the  temperature  of  the  tissue  at  specified  grid  points  above 
the  temperature  TSTEAM.  The  model  will  increment  TSTEAM  bv  DTST’I 
and  recompute  the  required  Dower  to  exceed  the  new  TSTEAM  tempera- 
ture. TSTEAM  continues  to  be  incremented  by  DTSTM  until  the  power 
to  produce  irreversible  danaqe  predicted  by  the  damane-inteqral 
method  is  less  than  the  power  required  to  raise  the  tissue  above 
the  temperature  TSTEAM.  At  this  point,  the  power  predicted  bv  the 
damaqe-inteqral  method  is  printed.  When  this  occurs  twice  in  se- 
quence, the  computation  is  stopped.  This  parameter  allows  the  user 
to  determine  what  powers  are  necessary  to  raise  the  tissue  above 
specified  temperatures  and  to  determine  the  power  needed  to  cause 
irreversible  damaqe  in  the  tissue. 

Units:  °C 

Suggested  input  value:  200. 

TVL— The  thickness  of  the  choriocapil laris. 

Units:  cm 

Suqqested  input  value:  Table  A-3 

VSHX(L) . Lsl ,6— The  heat  capacity  of  the  Lth  ocular  media. 

Units:  cal •cm“3*°C"^ 


WAVEL— The  wavelength  of  the  laser  radiation  in  air. 
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Units:  nm 

Suggested  input  value:  400.-1200.  nm 

XC— The  stretching  factor  for  time  intervals  associated  with  temperature 
calculations. 

Units:  unitless 

XC  = XCT(Ll)  single  pulse 
LI  = AL0G(DPULSE)/.69315  + 29. 

XC  = 1.4  multiple  pulse 

XCT(LI).  LI =1 ,38— An  array  of  expansion  factors  for  calculating  time  Inter- 
vals  in  a single-pulse  exposure  run. 

Units:  unitless 

Suggested  input  values:  Table  A-4 

LI  = AL0G(DPULSE)/.6931 5 + 29. 

XFLOW— The  rate  o^  blood  flow  to  the  tissues  surrounding  the  eve. 

Units:  g*cm“^’sec"^ 

Suggested  input  value:  .001 

XFLOMO(Ll),  Llsl,6--The  total  blood  flow  per  unit  area  leavinn  the  chorio- 
capillaris  at  a given  radial  distance. 

Units:  g«cm~2. sec-1 

XPD(K).  K=1,KT— The  normalized  temperature  rise  of  the  melanin  granules 
at  times  XT ( K) . The  temoerature  rises  are  normalized  to  the  average 
termerature  rise  that  would  occur  if  the  melanin  granules  were  not 
present.  Therefore,  if  the  effects  of  the  melanin  granules  are  not 
significant,  the  values  for  XPD(K)  will  be  1.0.  XPD(k)  values  are 
printed  in  consecutive  order  for  each  time  that  temperature  rises 
are  printed. 

Units:  unitless 

XT(K).  K=1.KT--The  time  following  the  start  of  an  exposure. 

Units:  sec 

Z--In  the  proqram  output  sections  Temoerature  Rises,  Predicted  Threshold 
Laser  Power,  and  Radial  Extent  of  Damage,  Z is  the  axial  depth  from 
the  anterior  boundary  of  the  oiqment  epithelium  at  which  temperature 
rise  and/or  damaoe  predictions  are  printed.  Positive  and  negative 
numbers  indicate  axial  distances  posterior  and  anterior,  respectively. 
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to  the  boundary  of  the  vitreous  humor  and  Diriment  epithelium.  In 
the  Grid  Information  output  section,  Z is  the  axial  distance  from 
the  front  of  the  cornea  to  the  individual  arid  points. 

Units:  cm 

ZH(I),  1*1 ,M— An  axial  distance  from  the  cornea  to  points  located  half- 
way  between  the  axial  arid  points  Z(I)  and  Z(I+1). 

Units:  cm 

ZM— Half  the  lenath  of  the  z-axis  of  the  modeled  eve. 

Units:  cm 

ZO— The  distance  of  the  pupil  from  the  nearest  laser  beam  waist.  It  must 
be  a positive  value;  i.e.,  only  diverging  beams  are  aoolicable.  ZO 
is  required  only  when  the  soread  function  is  used  (IFIL*1). 

Units:  cm 

Suggested  input  value:  2*RIM/full-anqle  divergence  at  RIM,  anglo 

in  radians. 
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From  Takata,  "Thermal  model  of  laser-induced  eye  damage 


TABLE  A-3.  THICKNESS  OF  OCULAR  MEDIA* 


Thickness  In  cm 


Code 

Eye  media 

Monkey 

Man 

TAV 

Cornea 

Aqueous  humor 
Lens 

Vitreous  humor 

5.16-10-2 

2.9-10"! 

3.5-10-1 

1.157 

5.86-10- 
3.1-10-] 
3.6-10-' 
1.697  , 

TPE 

Pigment  epithelium 

1.2-10-3 

1.4-10-3 

TVL 

Choriocapillaris 

1.0-10*3 

1.2-10-3 

TCH 

Choroid 

1 .68-10-2 
i.o-io-1 

1.42-107 

l.n-io-i 

TSC 

Sclera 

2 


*From  Takata,  "Thermal  model  of  laser-induced  eve  damaae." 
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TABLE  A-4.  PARAMETERS  FOR  COMPUTING  TIME  INTERVALS* 


L 

NPT(L) 

CHLi. 

KTT(L) 

1^ 

NPT(L) 

XCT(L) 

KTT(L) 

1 

1 

1.2 

47 

20 

39 

1.15 

55 

2 

3 

1.2 

47 

21 

40 

1.15 

56 

3 

5 

1.2 

47 

22 

41 

1.15 

57 

4 

7 

1.2 

47 

23 

42 

1.15 

58 

5 

10 

1.2 

47 

24 

43 

1.15 

59 

6 

14 

1.2 

47 

25 

44 

1.15 

60 

7 

18 

1.2 

48 

26 

45 

1.15 

61 

8 

21 

1.2 

43 

27 

46 

1.15 

62 

9 

25 

1.2 

49 

28 

47 

1.15 

63 

10 

28 

1.2 

49 

29 

48 

1.1 

64 

11 

30 

1.2 

30 

49 

1.1 

64 

12 

31 

1.2 

31 

50 

1.1 

65 

13 

32 

1.2 

32 

51 

1.1 

66 

14 

33 

1.2 

>1 

33 

52 

1.1 

67 

15 

34 

1.15 

52 

34 

53 

1.1 

68 

16 

35 

1.15 

52 

35 

54 

1.1 

69 

17 

36 

1.15 

53 

36 

55 

1.1 

69 

18 

37 

1.15 

54 

37 

56 

1.1 

70 

19 

38 

1.15 

54 

38 

57 

1.1 

70 

*From 

Takata, 

"Thermal  model 

of  laser- 

-induced 

1 eye  damage 
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> • 

38 


mcsjrorocvJOOOOCvjrovor^ro^rr^cNjcovo^rrocNj*— 
cvjiDOinKo>r^ooro{^^)^  ncor-  r-  oooooo 
in  o ro  co  in  ro  c\j  r- r-  ooooooooooooo 


c^vDr-criimnoi^N^CDco^^f^csia>vD^-roC'J»- 
«t^o^ocoo^ocoo>r>cuD'tfONr-r-oooooo 
roooto^-Csjr—  »—  ooooooooooooo 


^■mC\lr-»—  »—  »—  r— 


aivDcoN<^«-o(M»-oootn^)oo(0(^oi^^{vjr- 
a^r^cvjcvjf—  c\jct>o  ^ o n ro  cm  r- r-  oooooo 

CT»C^^-CT»V£)^rC\JCVJr—  r—oOOOOOOOOOOO 


N^covD^Nr-a»Nrorocvrv^oro(^Ni/)ncNjr- 
NONCO^CnoO^ON^^CVJr-r-OOOOOO 
<NJCO^<T»v£>^rOCSJr-r—  OOOOOOOOOOOO 


OONNO^WNC\JMnncONO^ONi/)«tNr- 

CT>  c\j  LO  O LD  » — • — LT>  o N in  m CO  I — * — . — OOOOO 
ir>  in  in  o vo  ^ ro  cvj  r- r-  oooooooooooo 

iDCOCVJCvJr-r-r-r-r-r-r-r-r-i — r—  t — i — p—  r—  r—  r—r— 


^■VO^r-NCVJ^LnNf-COini^COO^ONl^^Mr- 

^inCVJinO^NCVJCVJlDf-N^fOCVJMr-r-OOOOO 

ovovoovo^cocvjr— r-000000000000 

• •#••••••••••••••••••• 


O^^^^inOCfi^fO^r-rSr-^r-lDONinCCVJr- 

^oo^(via>ronu)r*coin^csjcMr-r-ooooo 
rOOOPNON^ffOC^  r-1-  oooooooooooo 


u)Orv^ttno\a>cvja^ON,4-J'cviO»-ir>r-cDLn^c\jr- 
r-'.OCO^lflO’t^Or-iOtnrfnCVJr-r-OOOOO 
cocr»r^r— r^Lncocvjr—  r-000000000000 


<T»C\J^^t^OCT4CVJr-  tncos  r-  Or—  (VJ  O r-  CQ  VO  ^ C\J  r— 

inrONa»cocvjc£>inNCvjcou3^ncM^»-ooooo 

cor-oOf—  r^iorocvir-  #-*000000000000 


0(T»l^>r^CT»0vX)0»— r^O^^>C\irOU3C\JCOsiD^-C\JC\J 

Or'VOitr-inNcOCOCMC^^<trO(Mf-r-00000 

ofOa»NooinfocMr-r.oooooooooooo 


r—  O'*  CT»  O'* 

cn  r—  cvj  0 

• I I I 

^000 

r—  CNJ  PO 


*Tron  t a kata , "Thermal  model  of  laser-induced  eye  damage. 
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TABLE  A-6. 

ZERO-ORDER  BESSEL  FUNCTION* 

Zero  Order 

Zero  Order 

L 

Bessel  Fn  J0(L) 

L 

Bessel  Fn  J0(L) 

1 

1.00000 

17 

.45540 

2 

.99750 

18 

.39798 

3 

.99002 

19 

.33998 

4 

.97762 

20 

.28181 

3 

.96039 

21 

.22389 

c 

.93346 

22 

.16660 

7 

.91200 

23 

.11036 

3 

.38120 

24 

.05553 

3 

.84628 

25 

.00250 

10 

.80752 

26 

-.04838 

11 

.76519 

27 

-.09680 

12 

.71962 

28 

-.14244 

13 

.67113 

29 

-.18503 

14 

.62008 

30 

-.22431 

15 

.56685 

31 

-.26005 

16 

.51182 

32 

-.29206 

*From  Takata,  "Thermal  Model 

of  laser-induced  eye  damage." 

TABLE  A-7.  REFRACTIVE 

: INDEXES* 

Refractive 

Refractive 

Wavelength 

index  NA(L) 

Wavelenoth 

index  NA(L) 

L 

nm 

(WATER) 

L 

nm 

(WATER) 

1 

350 

1 .357  (not  water) 

12 

900 

1.328 

2 

400 

1 .346  (not  water) 

13 

950 

1.327 

3 

450 

1.341  (not  water) 

14 

1000 

1.326 

4 

500 

1.336 

15 

1050 

1.325 

5 

550 

1.334 

16 

1100 

1.324 

6 

600 

1.332 

17 

1150 

1.3235 

7 

650 

1.331 

18 

1200 

1.323 

8 

700 

1.330 

19 

1250 

1.322 

9 

750 

1.329 

20 

1300 

1.321 

10 

800 

1.32P 

21 

1350 

1.320 

11 

850 

1.327 

22 

1400 

1.320 

*From  Takata,  "Thermal  Model  of  laser-induced  eye  damage. 
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PLOT  ROUTINE 

The  plot  routine  was  developed  to  display  two-  and  three-dimensional 
temperature  rise  profiles  as  a function  of  radial  and  axial  coordinates  at 
selected  times.  At  specified  qrid  points,  the  routine  utilizes  card- 
punched  temperature  data  that  are  output  by  the  retinal  program,  and  will 
generate,  for  each  data  set,  as  many  plots  as  desired.  For  each  plot,  the 
user  specifies  the  physical  size  of  the  plot  area  on  the  Model  1765  Calcomp 
plotter  and  can  view  the  profiles  at  any  angle  desired  by  using  a suc- 
cession of  rotation,  scaling,  and  translation  commands. 

The  R-axis,  Z-axis,  and  T-axis  of  the  temperature  rise  plots  refer  to 
the  radial  coordinates,  the  axial  coordinates,  and  the  temperature  rises, 
respectively.  The  permanent  viewing  axes  (x,y,z)  are  set  up  In  a riqht- 
hand  coordinate  system  with  the  permanent  x-axis  horizontal  to  the  right, 
the  y-axis  vertical  and  up,  and  the  z-axis  cominq  perpendicularly  out  of 
the  viewing  plane.  Initially  the  RZT  axes  and  the  permanent  xyz  axes  have 
the  same  orientation  and  oriqin.  All  rotations  and  translations  are  in 
relation  to  the  permanent  axes  and  independent  of  any  previous  commands. 

Good  three-dimensional  views  are  obtained  by  a succession  of  these  commands. 

The  input  deck  for  the  plot  routine  for  a single  set  of  temperature 
data  can  be  separated  into  two  sections.  The  first  section  consists  of 
the  necessary  temperature  data  on  cards  that  are  punched  as  output  from 
the  retinal  program.  The  data  cards,  for  each  selected  time,  should  be 
placed  as  input  to  the  plot  routine  in  the  order  in  which  they  are  punched 
with  one  exception.  After  the  retinal  program  punches  the  cards  contain- 
ing the  temperature  data  for  the  selected  times  from  any  one  run,  it 
punches  MAX  RGV  CARD(S)  FOLLOW  on  a comment  card.  This  is  followed  bv  a 
number  of  cards,  equal  to  the  number  of  selected  times  (KTYPE)  and  each 
containing  the  maximum  temperature  rise.  This  maximum  rise  is  used  to  de- 
termine a scalinq  factor  for  the  temperature  rises.  The  scaling  factor  is 
a power  of  10  chosen  internally  to  out  the  maximum  temperature  rise  in 
the  l-to-12  range.  The  coiment  card  (MAX  RGV  CARD(S)  FOLLOW)  should  be 
discarded.  A maximum- temperature-rise  card  must  be  placed  at  the  end  of 
the  set  of  temperature  data  for  each  selected  time.  When  cards  have  been 
punched  for  more  than  a sinqle  selected  time  (KTYPE  >1),  the  end  of  each 
set  of  temperature  data  can  be  found  by  locating  the  initial  card  of  the 
succeeding  set.  This  initial  card  contains  NRUN,  NPULSE,  and  REPET  and 
is  the  only  card  with  the  format  217,  E10.4.  When  onlv  one  selected  time 
(KTYPE=1)  has  been  punched,  the  only  deck  manipulation  is  to  discard  the 
comment  card. 

The  second  section  contains  the  command  data  for  plottina.  These 
commands  scale,  rotate,  and  translate  the  axes  and  establish  the  viewing 
screen  for  the  desired  plots.  A uniform  format  for  all  commands  and  their 
associated  parameters  is  used: 
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Columns 

1-4 

keyword 

left-justified 


Columns 

11-20 

TTE 

parameter 


Columns 

21-30 

73 

oarameter 


Columns 
31-40 
13 

parameter, etc. 


To  identify  the  desired  command,  a keyword  in  alphanumeric  format  is 
entered  in  columns  1-4.  Parameters,  as  applicable,  are  entered  as  floatlno- 
point  numbers  in  10-character-wide  fields  startino  with  column  11. 

A blank  entry  is  always  read  as  a floating  number  with  value  zero. 


Several  commands  normally  precede  any  others  when  the  seauence  of 
input  plotting  commands  is  set  up.  The  first  command,  DUM,  has  no  effect 
on  the  actual  plot  setup,  but  requests  a summary  of  all  the  points  in  the 
data  base— with  the  low,  hiqh,  and  mean  values  for  tne  R,  Z,  and  T ranqes 
of  data  to  be  printed. 

The  second  command,  SCRN,  sets  up  the  size  and  position  of  the  dis- 
play area  as  measured  on  the  Cal  comp  plotter.  Without  this  conwnand,  the 
program  will  not  plot. 


The  third  command  in  the  sequence,  BOX,  scales  the  object  to  fit  the 
viewing  area  established  by  SCRN  and  centers  the  object  on  the  orlqin. 

This  eliminates  losinq  plots  due  to  disparity  between  coordinate  magnitudes. 

Without  any  further  information,  the  program  would  plot  an  isometric 
R-Z  view  of  the  object,  givinq  a plot  of  the  radial  vs  axial  arid  points. 
Table  B-l  contains  a sample  input  deck  used  to  obtain  an  P-T  view  (radial 
vs  temperature),  a Z-T  view  (axial  vs  temperature),  and  a good  three- 
dimensional  isometric  view.  Cards  1 through  17  contain  the  data  and  in- 
formation supplied  by  the  Retinal  Thermal  Model.  Within  this  section, 
cards  11  throuoh  16  contain  the  actual  temperature  data  to  be  plotted. 

Card  17  is  the  maximum  RGV  value  card.  Cards  18  through  33  contain  the 
individual  plot  commands.  These  can  be  used  with  any  set  of  input  data 
to  obtain  the  same  basic  results.  The  plots  generated  by  these  commands 
are  shown  in  Figures  B-l  throuoh  B-3. 


The  three  rotation  commands,  PITC,  YAW,  and  ROLL  (about  the  permanent 
xyz  axes)  are  the  most  conmonly  used  commands  to  move  the  object  and  ob- 
tain the  desired  view.  The  command  TRAN  can  also  be  used  to  move  the 
object  through  a translation  relative  to  the  oermanent  origin. 

In  addition  to  the  positional  commands,  several  commands  can  be  used 
to  scale  the  temperature  rise  profiles  and  change  the  viewing  perspective. 
Two  commands  (besides  BOX)  have  a scaling  effect  on  the  plots:  SCAL  can 

rescale  the  R,  Z,  and  T coordinates  independently;  and  FACT  simply  blows 
up  or  shrinks  all  plotting  by  applying  the  same  scaling  factor  to  all 
three  of  the  axes.  The  command  DIST,  used  to  determine  the  viewing  per- 
spective of  the  plotted  object,  allows  the  viewer  to  adiust  his  position 
and  distance  relative  to  the  permanent  origin  and  to  soecifv  his  distance 
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from  the  plane  onto  which  the  three-dimensional  obiect  has  been  projected. 
Without  DIST,  the  program  assumes  an  isometric  vievj,  with  the  permanent 
oriqin  lyinq  in  the  projection  plane.  If  an  enlargement  of  a portion  of 
a plot  is  desired,  the  WIND  command  is  used.  This  automatically  scales 
up  the  area  of  interest  to  fill  the  screen,  and  the  rest  of  the  Dlot  is 
cut  off. 

To  obtain  any  plottinq,  the  command  PLOT  must  be  used.  This  calls 
on  the  plot  subroutine  to  plot  the  current  view  of  the  object  as  defined 
by  the  previously  built-up  commands.  Normally,  the  nlot  includes  all 
lines  whether  or  not  they  would  be  seen  by  the  observer  of  the  three- 
dimensional  object.  Tne  hidden  lines  can  be  dashed  or  totally  removed 
by  usinq  the  command  HIDE.  The  visibility  of  a line  is  determined  by 
the  surface  normal  vectors  entered  in  the  plot  file,  which  can  be  re- 
versed by  the  command  SIGN.  After  a plot  command,  a quick  reinitializa- 
tion of  the  transformation  matrix  is  achieved  by  the  comnand  REIN.  This 
erases  all  of  the  previously  built-up  results  from  the  positional  and 
the  scaling  commands. 


The  sequence  of  plottinq  commands  listed  in  Table  B-l  is  generally 
adequate  for  plottinq  temperature  profiles;  however,  the  commands  and 
their  sequence  can  be  chanqed  at  any  time  to  fit  the  user's  desire.  The 
list  in  Table  B-l  is  given  as  a description  of  each  innut  command  and  its 
associated  parameters  and  is  presented  in  sequence  of  general  usage. 

DUH  command— Requests  a suronary  of  the  current  number  of  points  in 
the  data  base  and  of  the  R,  Z,  and  T ranges  of  the  data.  DUM  is  usually 
the  first  command  entered  in  any  command  sequence  and  has  no  parameters 
associated  with  it. 

SCRN(A  B C D E)  comnand--Sets  up  the  physical  size  of  the  displav 
area  and  araws  a border  around  that  area  for  every  plot.  Without  either 
this  or  the  window  command,  the  Cal  comp  plotter  will  not  plot.  For  each 
set  of  temperature  data,  the  screen  command  remains  in  effect  and  is 
affected  only  by  subsequent  screen  commands.  Parameters  A and  B are  the 
coordinates  of  the  lower  left  corner  of  the  screen  in  reference  to  the 
permanent  origin;  C and  D describe  width  and  height;  and  E,  the  fifth 
parameter,  may  be  entered  to  define  a three-dimensional  rectangular  box 
with  E as  the  depth  (units  are  all  in  inches). 


B0X(A  B C)  command— Causes  the  object  being  plotted  to  fill  a frac- 
tion of  the  screen  area.  The  object  is  first  moved  so  that  its  center  of 
gravity  is  coincident  with  the  permanent  origin  and  then  rescaled  from 
there  to  fill  a proportion  of  the  available  viewinq  area,  as  determined  by 
parameters  A,  B,  and  C.  When  only  A is  entered,  a single  scale  is  applied 
to  all  three  axes.  If  all  three  parameters  are  entered,  the  object  is 
scaled  to  fit  the  A,  B,  and  C proportions  of  the  snecified  x,  v,  and  z 
screen  dimensions  respectively.  The  parameters  are  generally  set  at 
values  slightly  less  than  unity;  such  as  0.9  or  0.85. 
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ROLL f A ) conrnand— Indicates  that  the  object  should  move  counterclock- 
wise in  the  viewing  plane  by  an  angle  of  A deqrees.  The  Dermanent  z-axis 
is  the  axis  of  rotation. 

PITC(A)  command— Indicates  that  the  object  should  rotate  A degrees 
around  the  permanent  x-axis  so  that  the  top  part  of  the  screen  will  come 
toward  the  viewer. 

YAW(A)  command— Indicates  that  the  object  should  rotate  A degrees 
around  the  permanent  y-  (or  vertical)  axis  so  that  the  rightmost  portion 
of  the  screen  will  move  away  from  the  viewer. 

PLQT( A B)  command— Causes  the  current  view  (as  defined  by  BOX,  DIST, 
ROLL,  PlYc,  YAW)  oY  the  object  to  be  plotted.  Parameters  A and  B define 
the  relative  X and  Y advance  on  the  CalcomD  plotter  for  a permanent  new 
origin  of  coordinates.  A and  B are  interpreted  as  real  inches.  So  that 
tne  title  of  the  plots  and  scalina  information  will  be  appropriately  dis- 
played for  each  set  of  plottinq  data,  A=1 2.75  must  be  on  the  first  PLOT 
comnand  card  used.  Also,  B=0  must  be  on  every  PLOT  command  card  after 
the  first  so  that  succeeding  plots  have  a common  baseline. 

DIST(A  B X Y)  command— Adjusts  the  distance  of  the  observer  from  the 
object.  fY  no  parameter  or  zero-valued  parameters  are  entered,  the  view 
will  be  isometric.  If  both  A and  B are  nonzero,  A is  the  distance  of  the 
viewer  from  tne  projection  plane  and  B is  the  distance  of  the  viewer  from 
the  permanent  origin.  When  A is  nonzero  and  B is  zero,  parameter  A is 
applied  to  both  distances.  Optional  third  and  fourth  parameters,  X and  Y, 
may  be  added  to  allow  the  viewer  to  shift  his  viewing  position  with  re- 
spect to  the  z-axis.  (All  four  parameters  are  in  units  of  inches. 1 

REIil  command--Reinitializes  the  object  to  its  oriqinal  position  bv 
unitizing  the  transformation  matrix.  All  previously  built-up  results  from 
roll,  pitch,  yaw,  scale,  box,  and  translation  commands  are  lost. 

HIDE (A)  comnand— Calls  for  a change  in  the  use  of  the  hidden-line 
calculation.  Through  this  calculation,  lines  not  normally  seen  by  an 
observer  of  a three-dimensional  ob.iect  mav  be  dashed  or  removed.  If  param- 
eter A is  zero,  the  hidden-line  calculation  is  not  used  and  all  lines  are 
drawn.  If  A is  1.0,  the  hidden  lines  are  removed;  and  if  A is  2.0,  the 
hidden  lines  are  dashed.  The  most  recent  HIDE  command  will  remain  in 
effect  until  it  is  superseded  by  another  HIDE  command. 

FACT(A)  command— Simply  expands  or  shrinks  all  plotting  dimensions 
along  all  axes  by  factor  A. 

SCAL(A  B C)  conrnand--Rescales  the  current  object.  If  factors  B and 
C are  both  zero,  all  three  dimensions  are  rescaled  uniformly  by  factor  A. 

In  this  situation,  the  cotmands  SCAL  and  FACT  are  identical.  Otherwise, 
the  R,  Z,  and  T coordinates  are  independently  scaled  by  factors  A,  B,  and 
C respectively. 
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SIGN  (A)  command— Used  to  reverse  the  sense  of  the  surface  normals 
entered  in  the  data  base.  To  do  this,  A should  be  set  equal  to  -1.0. 

TRAN  (A  B C)  command— Effects  a translation  of  the  current  object 
position  through  a vector  (A,B,C)  relative  to  the  permanent  oriqin.  A, 

B,  and  C are  in  terms  of  inches  along  the  permanent  x,  y,  and  z axes, 
respectively. 

WIND  (ABC  0)  command— Used  to  zoom  in  on  any  portion  of  the  current 
plot.  A and  0 are  the  lower  left-hand  coordinates  of  the  windowed  area, 
and  C and  D give  the  horizontal  and  vertical  extent  of  the  windowed  area 
in  terms  of  the  permanent  display  coordinates.  The  windowed  area  is  then 
blown  up  to  fill  the  entire  screen  area.  If  the  screen  command  has  not 
been  effected,  this  command  acts  as  a screen  with  A,  B,  C,  and  D having 
the  same  meaning  as  their  equivalents  for  SCRN.  The  window  command  is 
only  in  effect  for  the  immediately  followinq  plot,  but  can  be  reactivated 
by  entering  a WIND  card  with  no  parameters.  In  this  case,  the  previous 
window,  with  its  parameters,  is  put  into  effect. 
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TABLE  B-l . SAMPLE  PLOT  INPUT  (WITH  COMMENTS) 
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Figure  B-3.  Three-dimensional  view  of  temperature  rise. 
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APPENDIX  C 

INPUT-OUTPUT  PROCESSES 


This  appendix  will  provide  the  user  at  Brooks  AFB  with  the  basic  in- 
formation necessary  to  run  the  retinal  model  on  an  IBM  360/65  comnuter, 
and  will  serve  as  an  example  for  similar  setups.  One  such  computer  is 
located  at  the  San  Antonio  Data  Service  Center  (SADSC),  with  a remote 
terminal  at  Brooks  AFB.  The  prospective  user  should  be  familiar  with 
the  required  input  data  cards  as  outlined  in  text.  Input  Requirements 
section. 

At  Brooks  AFB,  the  retinal  models  (HBR01RE1  and  UBR01RE2)  are  stored 
on  a computer  disk  library.  This  eliminates  having  to  submit  and  recom- 
pile the  entire  program  for  each  set  of  data  cards.  Therefore,  in  addi- 
tion to  the  data  cards,  only  the  Job  Control  Languaqe  ( JCL ) cards  are 
necessary.  These  are  used  to  call  the  stored  proqram  and  to  set  un  the 
program  for  operation  on  the  IBM  360/65.  Figure  C-l  is  an  example  of  a 
deck  used  to  call  up  a stored  program. 

Of  the  JCL  cards,  the  job  (JOB),  execute  (EXEC),  and  data  definition 
( L)D ) cards  are  required  by  any  IBM  360  operating  system.  The  SETUP  card 
is  required  by  SADSC  for  long-running  programs  and  proorams  reouiring 
large  core.  In  addition,  several  of  the  parameters  on  the  JOB,  LXEC, 
and  DD  cards  are  controlled  by  SADSC.  The  following  is  a list  of  these 
JCL  cards  with  the  parameters  and  formats  required  to  call  and  run  the 
retinal  proqram  (HBR01RE2)  on  the  computer. 

(1)  JOB.  The  job  cards  identify  the  beginning  of  a new  job; 
therefore,  they  must  always  be  the  initial  cards  in  the  deck  setup.  ” ey 
are  variable-field  control  cards,  but  have  certain  requirements  placed 
on  them  by  SADSC.  They  should  fit  the  following  format: 

« 

//HBaaabbbKJ0B|*(3H!Jl  ,B020,cccc,ddd,eeee,  ,,Y,ff ) , 'HBqqgqqql0Rt<hhhhhhhh  ' • 
//&CIASS=H,PRTY=5,MSGCLASS=A,MSGLEVEL=(2,0) 

The  parameters  that  are  variable,  depending  on  the  user  and  the 
job  beinq  run,  are  represented  by  the  lowercase  letters  above  and  are  as 
follows  (K  must  be  blank): 

aaa  - Unique  user  code  assiqned  to  each  user  for  identity, 
bbb  - Up  to  3 alphanumeric  characters  (plus  0,  #,  and  $ when 


desired)  assiqned  by  the  user  to  identify  the  job.  This  and  the  user 
code,  tooether.  make  up  the  iob  name. 


cccc  - Job  execution  time  in  minutes.  This  is  the  total 
estimated  time  for  job  execution--the  sum  of  the  central  processing  unit 
(CPU)  time,  wait  time,  and  input/outnut  (I/O)  time  requi renents--and  may 
consist  of  up  to  4 diqits.  Details  on  the  SADSC  job  class  requirements 
(set  forth  later  in  the  sequel)  will  help  the  user  arrive  at  a suitable 
time  estimate.  A suqqested  time  estimate  is  1.5  times  the  amount  of  CPU 
time  entered  on  the  EXEC  card. 

ddd  - Estimated  output  line  count  (in  thousands  of  lines), 
consistinq  of  up  to  3 diqits.  It  is  recommended  that  this  value  be  SPt 
at  9 and  chanqed  as  experience  dictates.  SADSC  operators  will  automati- 
cally cancel  the  job  if  the  specified  line  count  is  exceeded  by  9000. 

eeee  - Estimated  card  count  (in  hundreds  of  plot  data  cards 
to  be  punched),  consistinq  of  up  to  4 diqits.  A card  count  based  on  an 
averaqe  of  30-40  plot  cards  for  each  set  of  temperature  rise  values  cor- 
respondinq  to  a selected  time  is  recommended.  SADSC  operators  will  can- 
cel the  job  if  the  card  count  is  exceeded  by  3000. 

ff  - Maximum  number  of  lines  to  be  printed  oer  page.  This 
may  consist  of  up  to  2 digits,  up  to  a value  of  61.  To  fullv  utilize 
the  output  paper,  the  value  of  61  is  recomnended. 

gqggqq  - Cost-accountinq  code  associated  with  the  particular 
work  unit  under  which  the  job  is  being  run.  If  this  code  is  less  than  6 
characters,  it  must  be  left-justified,  with  @ signs  actina  as  fill  char- 
acters on  the  right  to  complete  the  6-character  subfield. 

hhhhhhhh  - User's  last  name.  Up  to  8 alphabetic  characters 

may  be  used. 

The  cost-accountinq  code  is  the  only  item  reouirinq  its  associ- 
ated subfield  to  be  complete.  When  not  used  to  the  maximum,  other  sub- 
fields should  be  closed  up  to  include  only  that  portion  being  used.  All 
other  parameters  and  values  on  tne  JOB  cards  should  be  included  and  left 
as  they  are.  However,  the  time  reouirements  may  necessitate  a chanqe  in 
"CLASS="  designation  as  set  forth  later  in  the  sequence. 

(2)  COMMENT.  Cards  having  //*  in  the  first  three  columns  may 
be  used  as  comment  cards  to  supply  information  concerninq  the  program  to 
the  user.  They  should  be  placed  after  the  JOB  cards  but  before  anv  data 
definition  cards.  They  have  no  effect  upon  the  runnina  of  the  proqram. 

(3)  SETUP.  Special  resources  renuired  durino  job  execution  are 
indicated  by  the  setup  card.  It  is  listed  on  the  computer  console  when 
the  job  enters  the  system,  alerting  the  SADSC  computer  operator  of  anv 
requirements  for  large  amounts  of  CPU  time  and/or  core  storaqe.  For  re- 
tinal modal  RE2,  the  format  for  this  card  is: 

/*SETUPMl!(|!it!*tW376K  CORE  ROD,  aaa  CPU  MINS' 
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Columns  8-15  on  the  card  should  alwavs  be  blank,  and  the  messane  must  be 
in  quotes.  The  number  of  CPU  minutes  denends  on  the  number  of  data  sets 
beinq  run  and  the  data  itself.  A trial  value  of  1 minute  for  each  NRUN 
set  of  data  is  sunqested.  For  4 sets  of  data,  the  CPU  time  would  be  4. 

If  CPU  time  limit  exceeds  10  minutes,  the  job  should  be  submitted  as  two 
or  more  jobs. 

(4)  EXEC.  The  execute  card  tells  the  computer  what  tvne  of 
action  the  user  wants  on  the  source  or  data  deck  which  will  follow.  For 
RE2,  the  EXEC  card  nas  the  following  format: 

//STEP1UEXEC#FORTGO,PROGRAM=HBR01 RE2, REGION. G0=376K,TIME.G0=aaa 

This  card  identifies  the  GO  step  as  the  steo  to  be  executed.  The  GO  step 
calls  for  execution  of  the  program  named  HBR01RE2,  which  has  been  compiled 
in  FORTRAN  IV  lanquaqe.  This  card  further  requests  a core  size  of  376K 
and  sets  a CPU  time  limit  (aaa)  on  the  execution  of  the  GO  step.  This 
time  limit  should  equal  the  tine  requirement  quoted  in  the  SETUP  messaae. 
If  either  the  core  size  or  the  CPU  time  limit  request  is  exceeded,  pro- 
gram execution  will  be  terminated. 

(5)  DO.  The  data  definition  cards  basically  supply  the  computer 
with  descriptions  of  data  sets.  Two  such  cards  are  required  in  core 
loading  and  runninq  the  RE2  program.  They  are  as  follows: 

//STEPLIB0DD0DSN=SYS1 ,TESTLIB,DISP=SHR 
//GO.SYSIN0DD0* 

The  first  card  identifies  the  system  library  (TESTLIB)  in  which  the  Dro- 
qram  mentioned  in  the  EXEC  statement  is  stored.  The  second  card  identi- 
fies the  cards  which  follow  it  as  data  cards  for  the  GO  step. 

(6)  DELIMITER  (/*).  A card  with  /*  in  the  first  two  columns 
(referred  to  as  a delimiter  card)  must  follow  the  data  card  deck.  It 
serves  as  the  end-of-file  card  for  the  card  deck. 

Occasionally,  the  user  may  need  to  recompile  the  program  (RE2)  and 
restore  it  in  the  computer  library.  To  do  this  with  a data  run  would 
require  a deck  setup  as  in  Fiqure  C-2.  The  JOB,  SETUP,  EXEC,  and  UD 
cards  require  some  changes  and  additions: 

(1)  JOB.  The  only  change  required  in  the  job  card  for  compilino 
and  running  the  RE2  program  is  in  the  estimated  job  execution  time.  The 
usual  total  estimated  job  time  should  be  increased  by  2 minutes  in  order 
to  satisfy  compiler  and  linkaqe  editor  time  requirements. 

(2)  SETUP.  As  on  the  JOB  card,  the  addition  o*  compiler  and 
linkage  editor  time  requirements  necessitates  an  increase  in  the  quoted 
CPU  time  requirement.  The  usual  time  requirement  quoted  on  the  SETUP 
messaqe  for  runninq  from  the  disk  library  should  be  increased  by  2 min- 
utes to  satisfy  the  extra  time  requirement. 
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(3)  EXEC.  To  compile  and  run  the  RE2  program,  the  execute  card 
has  the  followina  format: 

//STEP10EXECHFTG1CLG, REGION. F0RT=164K, REGION. LKED=114K,REGION.GO=376K, 
//i*TIHE=aaa 

This  card  identifies  FORT  (FORTRAN),  LKED  (linkaae  editor),  and  GO 
(execution)  as  steps  to  be  executed.  The  FORT  step  compiles  the  proqram, 
the  LKED  step  edits  and  stores  the  proqram,  and  the  GO  step  executes  the 
program.  The  card  requests  core  sizes  of  164K  for  FORT,  114K  for  LKED, 
and  376K  for  GO;  and  sets  a CPU  time  limit  (aaa)  to  accomplish  steps 
FORT,  LKED,  and  GO.  This  time  limit  should  be  equal  to  the  time  reouire- 
ment  quoted  on  the  SETUP  messaoe. 

(4)  DD.  Compiling,  storinq,  and  running  the  RE2  program  requires 
three  data  definition  cards.  They  are  formatted  as  follows: 

//FORT.SYSIN0DD#* 

//LKED.SYSLMOD#DD*DSN=SYS1.TESTLIB(HBR01P.E2),DISP=SHP 

//GO.SYSIN«DD&* 

The  first  DD  card  identifies  the  cards  that  follow  it  as  source  cards  for 
the  FORT  step.  A delimiter  card  follows  the  source,  or  program,  deck. 
Immediately  after  the  source-deck  delimiter  card,  the  second  DD  card  di- 
rects the  computer  to  store  the  program  in  system  library  TESTLIB  under 
the  name  HBR01RE2.  The  last  DD  card  identifies  the  cards  that  follow  it 
as  data  cards  for  the  GO  step.  A delimiter  card  is  at  the  end  of  the 
data  deck. 


The  SADSC  IBM  360/65  computer  system  has  a scanninq  procedure  in 
operation  to  detect  JCL  card  error.  Detection  of  a single  JCL  error  by 
the  scanner  terminates  further  processing  of  the  job.  One  such  error 
detected  is  a job  class  error.  Job  class  is  determined  bv  use  of  core 
requirements  and  CPU  characteristics.  Specifically,  the  ratio  o*  esti- 
mated job  time  (on  JOB  card)  to  the  time  reauest  entered  on  the  EXEC  card 
is  considered  as  >2:1  or  <2:1,  and  the  job  is  considered  I/O  bound  or 
CPU  bound  according  to  these  ratio  values.  The  user  selects  the  nrooer 
job  class  by  using  the  following  table  of  job  class  requirements: 


Core  requirements 
Max  Reqion  _<  74K  (DEFAULT) 

75K  <_  Max  reqion  _<  150K 
1 51 K <_  Max  reqion  <_300K 
301 K < Max  reqion 


>2:1  <2:1  J 

0 

A B b 

C D C 

1 

E F a 

s 

G H S 

e 

O.N.T.J  0,N,T,J  s 


5A 


Special  classes  not  verified 


If  the  user  wants  to  run  the  RE1  orooram,  which  uses  the  MX GRAN  sub- 
routine, the  followinq  chanoes  must  be  made: 

(1)  The  name  of  the  pronram  chanoed  from  HBR01RE2  to  HBR01RE1. 

(2)  The  core  requirement  for  execution  (GO)  increased  from  376K  to 
436K  on  both  the  SETUP  and  the  EXEC  cards.  All  other  oarameters  would  be 
used  as  outlined  for  the  RE2  nrooram. 

The  plot  routine  is  handled  in  the  same  manner  as  the  main  retinal 
pronram  and  is  stored  in  the  computer  library;  therefore,  it  has  the 
same  basic  JCL  card  setun  as  has  been  outlined  for  the  retinal  nrooram. 

An  examnle  of  a deck  used  to  call  and  run  the  olot  routine  is  shown  in 
Fiaure  C-3.  The  chanoes  that  are  reouired  are: 

(1)  The  name  of  the  nrooram  is  HBR01PLT. 

(2)  The  core  required  by  the  GO  steo  is  148K.  This  chanoe  should 
be  reflected  on  the  SETUP  and  E/EC  cards. 

(3)  For  normal  runninq,  FORTGO  on  the  EXEC  card  should  be  replaced 
by  PLOTGO.  For  compilinq,  the  equivalent  of  FTG1  on  the  EXEC  card  is 
PLOTG,  and  the  core  request  for  FORT  should  be  REGION. FORT=120K. 

(4)  The  TIME. GO  entrv  on  the  EXEC  card  should  be  approximately  0.05 
times  the  number  of  plots  desired. 

(5)  Set  both  estimated  time  and  line  count  to  10  on  the  .iob  card,  and 
adjust  as  experience  dictates.  The  number  of  cards  to  be  punched  should 
be  set  to  zero. 

(6)  The  ratio  of  estimated  job  time  (on  JOB  card)  to  the  time  re- 
auest  entered  on  the  EXEC  card  must  be  evaluated  to  determine  the  proper 
job  class  as  outlined  above.  This  is  controlled  by  the  parameter 
"CLASS="  on  the  JOB  card. 

(7)  A delimiter  card  goes  at  the  end  of  each  set  of  data. 

(8)  For  a sinqle  data  set,  a DD  card  (//GO.FT05F0020DDB*)  must  follow 
the  data-set  delimiter  card  and,  in  turn,  must  be  followed  by  a delimiter 
card.  For  multiple  sets  of  data  to  be  run  for  any  oiven  job,  a DD  card 
having  the  following  format  must  precede  each  data  set  subsequent  to  the 
first  set: 

//GO.FT05Faaa0DD0* 

A 3-diqit  number  (aaa)  indexes  the  sets  of  data  in  sequential  fashion; 
for  example,  aaa=002  for  the  second  set  of  data  [TIMEX(2)],  aaa=003  for 
the  third  set  [TIMEX ( 3 ) ] , etc.  A DD  card  of  this  format  must  also  follow 
the  last  data-set  delimiter  card  and  must  have  the  nrooer  index  number  for 
an  additional  data  set,  but  with  a delimiter  card  followinq  it. 
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The  computer  terminal  and  its  related  facilities  at  Brooks  AFB  are 
controlled  by  Biometrics  Division  of  the  USAF  School  of  Aerosoace 
Medicine. 

Before  runnino  anv  iobs,  the  user  should  familiarize  himself  with 
the  area  where  card  decks  are  submitted  and  returned  and  output  is  nicked 
up.  Two  tables  serve  these  purposes.  Decks  to  be  run  are  nlaced  In  the 
trav  on  the  input  table.  Also  on  the  input  table  Is  a loo  sheet  on  which 
the  user  must  record  each  ioh  submitted,  and  small  ounch/olot  cards  which 
must  be  filled  out  and  placed  with  the  card  deck  whenever  punched  cards 
or  plots  are  expected  as  output. 

All  output,  whether  Printed,  plotted,  or  punched,  is  nlaced  on  an 
output  table.  Card  decks  which  have  been  run  are  nlaced  in  travs  on  this 
table,  with  each  trav  filed  corresnondina  to  a ranoe  of  user-code  initial 
characters.  The  space  on  this  table  is  limited,  so  users  should  pick  un 
their  card  decks  and  output  within  a reasonable  time. 

A requirement  for  usino  the  computer  is  havinn  a valid  user  code.  A 
prospective  user  can  net  a user  code  from  the  director  o*  the  nroorammers, 
who  can  also  helo  in  identifvino  or  settino  un  the  proper  cost-accountinn 
codes  ass i oned  to  different  work  units.  If  either  of  these  codes  are  in- 
valid on  tno  JOB  card,  the  job  will  not  run. 

Several  computer- terminal  operators  are  constantly  in  the  inout/outnut 
area.  Questions  reoardino  any  part  of  the  Innut/outnut  process  and  re- 
ouests  for  assistance  with  any  of  the  machines  mav  be  directed  to  these 
operators. 


Figure  C-l.  Sample  card  deck  for  runninq  retinal  program  RE2 


Figure  C-2.  Sample  card  deck  for  compiling  and  running  retinal  program  RE2 


Figure  C-3.  Sample  card  deck  for  running  the  plot  routine 
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r 

c 

FETINAI  MODEL  IITPI 

^ 

RE  1 00001 

c 

V EPS 10 H 1 14  NOV  1975 

RE100002 

c 

It  MPEPATUP  Z AND  DAMAGE  PREDICTIONS  IN  AND  ABOUT  PETINA  CAUSED  BY  LAS 

ERFIOCOOj 

c 

NEW  PRINTOUT  TITLES  AND  GROUPINGS  OF  INFORMATION 

PEI  00004 

c 

UTILIZIS  SUBROUTINE  MXGIiAN 

PF1U000S 

c 

PEI  00006 

COMMON  A (2  9,3)  , A P , A A V ; ACH , A PE , ASC , ATS , A VL , B ( 1 4 , 3)  ,BB,BV(14,3)  , 

PE100C07 

1C0NX  (M  , CON  (29)  .CUT,  DFLOW  (6)  , DPULSE,  DB  , DT  , DTX  , DZ  , EL  , HR  (’4)  , 

PEI  00008 

21  Atl  (2  3,14)  , IELCOD  (1C)  , I HL,  IG  , IGX  , IHT,  I PA  , I PC  , I PE  , I PROF  , T PS  , I PT  , 

RE1000G9 

3IPV , T V (2  9)  , JVL , LIM, LPA , LPC, LPE, LPS, LPV , LPX ,LTM AX,  K , KH,KT,  M , Ml ,M2, 

FE1C0010 

4M3,N,»1,N3, N4,NVL,P0X,Pt  (14)  , PTIME,QP,P  (14) , F CC , F IH , PN , PPE ,RPT , 

FF1C001 1 

5?VL,RSC,S (29,14)  ,S H6, T AV , 7CH , TOM , TPF ,T VL, TS  (2200)  , TSC , ITS  , V ( 29 , 14)  PEI  00  0 12 

o, VC (2° , 14, 120)  , VSH  (2  9)  , VSHX  (6) , HAVEL ,XC, XFLOW , XFLON I (5)  , XFLOHO (b) 

,91100013 

7 X PD  (1  20)  , x : (120)  ,Z  (2  9)  , ZD  («)  , ZM  , FLOHI  ( 1 4)  ,FLOWX  ( 1 4)  , PI’PIL  , SIGMA  , 

S E 1 000  1 4 

BIPFT(IO)  ,At’E1,APE2,RINT,ZO, FLO, CA  BEB,CABEB2,PP,PC,NB,NC,  FC 

P? 1000 15 

DIMENSION  CXC  (14)  ,CXP  (29)  .DAMAGE  (2,2)  , DXC  (14)  ,DXF  (29)  ,FTI«E(38)  , 

BE  1 CO0 1 8 

1FXC  (14)  ,FXP  (29)  , IB  (230)  ,JD  (^30) , KTT  (38)  , N PT  ( 38)  , N PC  LS  F (7)  , NFUN  (7) 

,Frieooi7 

20  D (29, 14)  ,REPFT  (7) , TIMEX  (10)  , XCT  (38)  ,KQD  (29, 14) ,VE  (27, 1/0,2) , 

VI  100018 

3 V XX  (2  9, 14)  , VZ  (27 ,42,8,2)  ,ZT  (3)  ,Z~T  (8)  ,ZTX  (8)  ,SAVRGV  ( 1 9) 

P.F1  00019 

PEAL  LESION 

PF 100020 

2 FORMAT  ( 1 0 F 7 . 3 ) 

PE10C021 

3 FORMAT  (F7. 4 , 317) 

PF100022 

4 FORMAT  (1 1F7. 2) 

PF100023 

5 FORMAT  (1017) 

B* 100024 

f FOFMAT  (F7. 2,I7,2F7.2) 

PE100025 

1 

7 FORMAT  ( 1 0? 7 . 2) 

FE100026 

8 FORMAT  (17 , ?E7. 2) 

P El  00027 

Ik  1 

9 FOFMAT  (F7.2»2I7,F7.2) 

FE10002n 

3 0C  READ (5,4, END=200)  (FTIME(L)  ,L=1,36) 

RE100029 

READ (5,5) IP IT 

RF100C3S 

READ  (5,  3)  PIM, LIM, I ML,  IGX 

PEI  000  31 

READ  (5, 9) FKAX ,LIMAX, MAXPRT, LESION 

PF1C0032 

c 

«**  Sr"-  VALUES  FOF  MTFSBr,N,Nl,N3,N4,  AND  DP 

PEI  00033 

M T E S T = 0 

PE100034 

N 1 = 4 

BF1C0035 

N = N 1 + 9 

F F.  1 C0C36 

N J=N+ 1 

PEI  OOP  37 

N4=  N 1 ♦ 1 

PF.  100038 

1 

F EAD (5 , o) IPEOF,POW,CUT 

E El  00  039 

DP  = LF.  SION/LI  M 

PF100040 

%.  1 

IP( IPBOF. E0.0) DP=RIK/ (LIM-.5) 

Br1090U1 

READ  (5, 7)  DPULSE 

PEI  00042 

i 

R FAD  (5, 5)  NTEST,  (NR  UN  (L)  , L=  1 , NTEST) 

PE1000U3 

\ 1 

: E A D ( 5 , 7)  (FFPET(L)  ,L=1, NTEST) 

RE100044 

. EAD  (5,  5)  (NPULSE  (L)  ,L=1,NTES"r) 

EE100045 

READ  (5,5) IDl ,ID2, JD1 , JD2, IT VPS 

P El CC  04  6 

| 

L PX=  1 

PEI  00047 

IF (NTEST. EQ. 1 . AND. NFULSE (1)  . FQ.  1)  LPX=0 

PEI  000  48 

i 

XDP11LS  = DPULST 

BP  1 00049 

1 i 

7 ■ i 

X XQ= 1 . 

R FI  00050 

J *3 

IF  (DPULSE. GT .. 3E-8) GO  TO  10 

RE100C51 

' C 

**’  ADJUST  POWER  AND  PULSE  WIDTH  FOR  EXPOSURES  WITH  PULSIS  LESS  THAN 

PI  100052 

J C 

. 3 E - 8 SEC 

RE1C0053 

i 

X XQ  = . 3E-R/0PULSE 

PE1C0054 

} 

POW =POW* DPULSE/. 3F-8 

PF10OCS8 

h ■ i 

DPULSE=. 3r-8 

P T ' 1 C C C i 

rr 

*■  *fl» 

10  READ  (8,4)  T7  ,ET"-1  ,EDT2 

RE’ C0C57 

k 

52 

n 

1 

- - i:  1 

ii  EAD  (5,4)TOfl,APE,AVL,ACH,ASC,ATS,RCO,PRT,RSC,RPF,WAVIL  PEI ( 

READ  (5,4) TAV,TPF ,TVL,TCH,TSC,RVL  RF1( 

A A V=-  A LOG  (TOH)  /T  A V REK 

READ(5,  4)  (CONX(L) ,L=1,6)  FE1C 

READ  (5,4)  (VSHX (L)  ,L=1,6)  PE1C 

READ(5,5)  (NPT (L) ,L=1 , 38)  RE1C 

PEAD(5,2)  (XCT (L)  ,L=1,38)  RE1( 

READ(5,5)  (KTT (L)  ,L=1 ,3a)  RF 1 ( 

C *♦+  COMPUTE  DT,KB,KT,NP,PTIHE,TIBE,  AND  XC  REK 

L1  = ALOG (DPULSE)/. 69315  + 29.  RE  1 ( 

I F (LI . LT. 1) L 1 = 1 P Fit 

IF(L1 .GT. 38) L1=3b  PEK 

IF(LPX.E0. 1) GO  TO  11  PF 1 ( 

C *** SINGLE  PULSED  EXPOSURES  RE1< 

XC'=XCT  (LI)  RF1C 

NP=NPT(L1)  RE1( 

K ?=KTT  (L 1 ) . RE1C 

DT  = DPULSE*  (XC-1.)/(XC**NP-1 .)  PE1( 

TIME=DT- (XC**KT-1.)/(XC-1.)  PE1( 

GO  TO  13  RE  1C 

C ***  BULTIPLE  PULSED  EXPOSURES  RF1C 

11  XC= 1.4  RE1C 

NP=5  RF1C 

X1  = 0.  RE1C 

DO  12  L=  1 , NTEST  REK 

IF (XI .LT.NPULSE  (L) /RFPET (L) ) X1=NFULSE (L) /REPET (L)  RE  1C 

12  CONTINUE  PF1C 

TIBE  = FTIBE  (LI) *X1  RE  1 C 

DT=DPULSE*  (XC-1.)/(XC«*NP-1.)  RE1C 

KT=ALOG  (1 . +TIBE*  (XC-1.) /DT) /ALOG (XC) +1 . PEI C 

PTIBS=DPULSE/NP  RE1C 

13  KT=KT+ 1 PEI C 

KB=  N P+ 1 RE  1 C 

IF (KT.GT. 119) NEITL(6,14) KT  PF1C 

14  FOFBAT  (1H0,JHKT=,I3,2X,22HTIBE  DIBENSION  TOO  LOW)  PE1C 

IF (KI.GT.  1 19) STOP  RE1C 

C »*'  CALC.  DZ  AND  I INDICFS  PE'IC 

B 1 =6  Rr1C 

M = 2 *M 1 + 1 6 PE1C 

B 2=H/2  PE1C 

S3  = B+  1 P El C 

IPE=M2-M1+2  PF1C 

DZ=TPE/B1-1.E-25  RE1C 

I PA=2  PEI C 

C ***  STORE  AXIAL  DISTANCES  TO  INTERFACES  OF  EYE  PE1C 

ZD(1)=1.E-25  RF  1 C 

ZD (2) =TAV  RE1C 

ZD  (3) =ZD (2) +PPF  + TPE  RF1C 

7D  (4) =ZD  (3) ♦ (1 .-PPE) *TPE  FE1C 

ZD  (5) =ZD (4)  +TVL  RE1C 

ZD  (b) =ZD (5) +TCH  RE1C 

ZD  (7) =ZD  (6) +TSC  PFlC 

ZD  (8) =ZD  (7) +10.  PEI C 

CALL  GRID  RE1C 

NVL=LPV-IPV+1  PEI C 

C *+-  CALCULATE  AND  STORE  I,J  INDICES  AT  WHICH  TEMPERATURES  APE  PRINTED  PF1C 
ID1=ID1+IPE  PEI C 
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non 


ID2  = I'J2*IPE 

IF  (ID1 . L T . IRA) I P 1 = I P A 

IF  (ID  2 . GT . M ) I D2  = M 

IF  (JD2.GT. N) JD2  = N 

IF  (IPFT  (1 ) . FQ.C)  GO  TO  23 

WP ITE  (6 , 1 5) ID1,TD2,JD1,JD2 

15  FOFMAT(1H0,5X,4HIDl=,I3,3X,4HID2=,I3,3X,4HJDl=,I2,3L,4HJD2=, 
WHITE  (b,  16)  D R , D Z 

16  FORNAT(1HO,5X,3HDR=,E11.4,2X,3HDZ=,E11.4) 

BP  ITE  (6,17) IPA,IPC,IPE,IPS,IPT,IPV,LPA,LPC,LPE,LPS,LPV 

17  FOP  MAT  (1H0,5X,4HIPA=,I3,2X,4HIPC=,I3,2X,4HIPE=,I3,2X,4HIPS=, 
14HIPT=,I3,2X,4HIPV=,I3/1H  , 5X , 4HLPA=, I 3 , 2 X , 4HLPC= , I 3 , 2X , 4 HLP 
22X,4HLPS=,I3,2X,4HLPV=, 13) 

WRITE  (6,22)  M,M1,N,N1 

22  FOES AT  (1H0,5X,2HB=,I2,2X,3HH1=,I2,2X,2HN=,I2,2X,3HN1=,I2) 
WRITE  (6, 18)  (E  (J)  ,J=1,N3) 

18  FOPSAT  (1H0,5X,2HB=/(1H  ,5X,10F8.4)) 

WF.ITE  (6,19)  (Z  (I)  ,1  = 1, S3) 

19  FORMAT  ( 1 HO , 5X ,2HZ=/ ( 1 H ,5X,10F8.4)) 

23  DO  20  L1=1,NVL 

20  IBLOOD (LI) =IPV+L1-1 

C * **•  CALC.  NORMALIZED  LASER  PROFILES 

DO  21  L= 1 , N 3 

21  HR (L) =0. 

POX=POW 
CALL  IMAGE 
DO  27  J= 1 , N 3 
DO  27  1=1, M3 
V (T,J)=1.E-10 

27  3 (I , J)  =0 . 

b LAD (5,2) SHb,XFLOW,CFLOB 

C **•  SET  BLOOD  FLOW  PATES  ENTERING  AND  LEAVING  VASCULAR  LAYER  AS 
C **■*  FUNCTION  OF  HAPTAI  DISTANCE 
X2=C FLOW/ (3.1416*FVL*PVL) 

DFLOW (1) =0. 

X4  = 0. 

DO  30  L 1 = 2 , 6 

X4  = XU  + . 1 

30  DFLOW  (LI)  = X U 
DO  31  LI  = 1 , 6 
XFLOWI (Li) =X2 

31  XFLOWO(LI) =X2 
DO  34  1=1, M3 
DO  34  J = 1 , N 3 

34  VC(I,J,1) = 1 . E - 1 0 
XPO  W=  X X D * FO  W 
READ (5, 4) KTYPEO 
READ (5, 8) K"  YP  t 
L 1 =KT YPE 

IF  (KTYF5.EQ.C)  L 1 = 1 

READ  (5,7)  (TIMEX  (K)  ,K=1, LI) 

READ (5,5) 111,112, 113, JJ1,JJ2 

»**  START  OF  TEMPERATURE  CALCULATIONS  FOP  ONE  PULSE.  TO  BE  USED 
«->»  FOR  MUL”IPLE  OR  SINGLE  PULSED  EXPOSURES 

XT  (1) =0. 

D7X  = DT 


RE100115 
RE100116 
RE100117 
PE100118 
RE1C01 1° 
PF10012C 
12)  RE100121 

RE  100 1 22 
RE  1 00 1 23 
RE109124 
I3,2X,PF100125 
E= , 1 3 , PE  1 00 1 26 
PEI  00 127 
PEI  001 28 
PE  1 00 1 29 
PEI  00 1 30 
PEI  001 31 
FE100132 
RE  1 00 1 33 
P F 1 00 1 34 
RF100135 
R E 1 00 1 36 
R El  00 1 37 
RF100138 
R El  00 1 39 
RE10014C 
RE100141 
RF100142 
RE100143 

R E 100 144 

RE  1 00 1 45 
R E 1 00 1 46 
RF 1 00 1 47 
P 1 1 00 1 48 
RE100149 
RF100150 
RE  1 00 15 1 
RF100152 
RE100153 
PE100154 
Rr 100155 
RE  1 C0 1 56 
P El  00 1 57 
PF 100158 
Rt 100159 
RF10016Q 
RF1 00161 
PF1C0162 
FF10016 3 
F £ 1 CO  164 
PE100165 
PE10016O 
EITHERRF1 00167 
R El  00 168 
RE100169 
PFi 00 1 7r 
PF 1 00 1 7 1 
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f 


KTX=KT+ 1 F £ 1 00 1 72 

DO  36  K=2 , KTX  PE109173 

XT  (K) = X? (K-1)  *DT  PE100174 

36  DT=XC*DT  PF100178 

IKX=TIHE**EDT1*EDT2  PE100176 

IF  (IKX.LT. 1) IKX=1  RE100177 

XX=2*IKX  P E 1 00 1 78 

K=2  PEI  00 1 79 

IHT=2  F E 1 00 1 80 

ITYP£X=ITYPE  PF100181 

CALL  BLOOD  PE100182 

38  DT  = XT  (K) -XT  (K-1)  BE100183 

IF(K.GT.KH) QP=0.  BE100184 

CALL  HTXDEP  FE100185 

IF (K. GT. 2) 00  TO  41  FE100186 

IF(IPET(2) .EO.C) GO  TO  335  PE100187 

WRITE (6, 301)  FE100188 

301  FORMAT  (1HC,1 3HLASER  PROFILE)  FF10C189 

IF  (IPROF. EQ.O) WPITE (6, 302) RIM  RE100190 

302  FOPHAT(1H0,5X,4HRIM=,E10.3)  PE100191 

IF  (IPFOF.EQ.1) WRITE  (6,303) SIGMA , RIM ,CUT  R El  00192 

303  FORMAT  ( 1 HO , 5X , 6HSIGMA= , E 1 0 . 3 , 5x , 4 HRIM= , El 0 . 3 , 5 X , 4 HCUT= , El  0.3)  PEI  00 193 

IF (IFIL. EQ. 1) WRITE  (6, 304) RINT,ZO, PLO , C A BER , CABER 2 , P P , PC , NB,NC,FC,  F El  001 94 

1WAVEL  PE100195 

304  FOPMAT(1HC,5X,5HRINT=,E10.3,3X,3HZO=,E10.3,3X,4HFLO=,F6.3/1H  ,5X,  RE100196 

16HCABER=,E10.3, 3 X , 7HCAB£F2= , F7 . 0 , 3X , 3HPP= , F6 . 3/1 H , 5X , 3HPC = , F6 . 3 , R El  C0 197 
23 X, 3HNB=,F7. 3, 3X, 3 HNC=,P7. 3/1 H , 5X, 3HPC=, F6 . 3 , 3 X , 6 H WA VEL= , F7 . 1)  F El  C0 198 

IF (IFIL. EQ. 1) GO  TO  306  PE100199 

IF (IPROF. 5Q.2) WPITE  (6,305) RI NT  FE1C0200 

305  FOPMAT(1H0,5X,5HRINT=,E10.3)  PF100201 

306  WRITE (6, 307) QP  FF100202 

307  FOPMAT(1H0,5X,3HQP=,E10.3)  PE100203 

WRITE  (6, 308)  (HP  (J)  , J= 1 , N)  PF100204 

308  FORMAT  (1H0,5X,3HHR=/(1H  , 10X , 10E 1 0 . 3) ) PF100205 

335  IF(IPRT(3) .EQ.O)GO  TO  340  P5100206 

WRITE  (6, 309)  P El  00207 

3 09  FORMAT  (1H0, 19HDATA  IDENTIFICATION)  pn00208 

WRITE  (6,310)  (EEFET(L) ,L=1,NTEST)  FF100209 

310  FORMAT  (1H0,5X,6HREPET=/(1H  , 5X , 1 0E 1 0 . 3) ) FF10021C 

WPITE  (6, 311)  (HPULSF(L)  ,L=1,NTEST)  FL10021  1 

311  FORMAT  (1HC,5X ,7HNPULSE=/ (1 H ,5X,10I8))  PF100212 

WRITE  (6, 312)  AAV,ACH,APE,ASC,ATS,RCO,RRT,FPE,TOH,AVL,TAV,iCH,7PE,  1 5100213 

1 TSC , T VL , IGX, IFIL, IPR OF, LI M,NTEST,POW,XD PULS, RIM, RMAX, TIME, C FLOW,  F "100 21 4 
2XFLOW,SHB,EDT1,EDT2,DT,KM,KT,PTIHE,XC,IKX,AP,APE1,APE2,IG,EVL,  F FI  00  21 5 

3P0PIL,T0, LIMAX,MAXPRT  FEl 00216 

3 12  FOI-HAT  (1H0,SX,  4HAAV=,F7.1  , 2 X ,4 H ACH= , F7 . 0 , 2 X , 4 HAPF= , F7 . 0 , 2 X, 4 H ASC  = F r 1 002 1 7 
1,F7.0,2X,4HATS=,F7.0/1H  , 5X , 4HRCO=, F7 . 4 , 2X , 4H RRT=, F7 . 4 , 2 X , 4H F PE= , FF1C0218 
2f7.4,2X,4HTOK=,F7.4,2X,4HAVL=,F7.0/1H  , 5X , 4 HT A V= , E° . 3 , 2 X , 4HTCH= , FF1C0219 

3E9.3,2X,4HTPE=,E9.3,2X,4HTSC=,E9. 3 , 2X , 4HT VL=, E9 . 3/1 H , 5 X , 4HIGX= , I 2F E 1 00220 
4,2X,5HIFIL=,I2,2X,6HIPR0F=,I2,2X,4HLIM=,I2,2X,6HNTEST=,I2/1H  ,5X,  PE1C0221 
54HP0W  = ,E9.3,2X,7HDP0LSE  = , E9. 3 , 2X , 4HRIM= , F7 . 4 , 2 X , 5HRM A X= , F7 . 4 , 2 X , PEI  00222 
65HTIME=,E9. 3/1 H , 5X , 6 HCFLOW= , F7 . 4 , 2 X , 6HXFLOW= , P7 . 4 , 21 , 4HSHB= , F7 . 2 , F F 1 0022 3 
72X,5HEDT1  = ,F7.4,2X,5HEDT2=,P7.4/1 H , 5 X , 3H DT= , E9 . 3 , 2 X , 3HKM= , 1 3 , 2X , F5 100 224 
83HKT=,I3,2X,6HrTIME=,E9.3,2X,3HXC=,F5. 1/1 H , 5 X , 4 HIK X= , 12 , 2X , 3 HA P= , P E 1 00 22 5 
9F7.4,2X,5HAPE1=,F8.2,2X,5HAPE2=,F8.?,2X,3HIG=,I3/1H  ,5X,4HRVL=,  51100226 

1F6.3,2X,6HPUPIL=,F6.3,2X,3HT0=,F5. 1 , 2 X , 6HLIM A X=, 12 , 2 X , 7HM A XP RT~ , FE 100227 

212)  P E 1 00228 
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3 40 
313 
3 14 
3 15 
3 1b 

317 
3’b 
3 55 


3 19 


40 

41 

42 

« *> 
* ■ * 

3 5o 

43 


44 


45 

46 

*** 


IF  (IPS?  (4)  . _'Q.  0)  GO  TO  355 
WRITE  (6, 31 3) 

FORMAT  (1H0, 3CHBLOOD  FLOW  AND  HEAT  DEPOSITION) 
WRITE  (6, 3 14)  (FLOWI (J)  , J=1 , JVL) 

FORMAT  (1HC,5X,6HFLOWI=/(1H  , 5X , 1 OE 1 0 . 3)  ) 

WRITE  (6,315)  (FLOW  X ( J)  ,J=1,JVL) 

FORMAT  (1  HO, 5X,6HFIOWX=/(1H  , 5X, 1 C El C . 3) ) 

WRITE  (6,316) 

FORMAT  (1H  ) 

DO  316  I=IPA,M 
W PI mE  (6,317)  (S  (I, J)  , J = 1, N) 

FORMAT  ( 1 H , 5X  , 2llS  = , 1 0F8 . 3) 

CONTINUE 

IF  (IPHT (5)  . IQ. C) GC  TO  41 
WRITE  (6,319) 

FORMAT  (1  HO, 1 7HTEMR FRATURF  RISES) 
JCN?=JD2-JD1+1 


P F 1 0022Q 
RF1 0023n 
FE100231 
EF100232 
EE100233 
f 2100234 
RF10023S 
F- El  00236 
FE100237 
R F 1 002  38 
RE100239 
RF1C0240 
R'?100241 
FF100242 
F El  00243 
FI1 00244 
FE100245 


IF(JCNT.GT.9) GO  TO  40  FF10C246 

GO  TO  41  PEI  00247 

JJCNT=JCNT-9  PEI  00249 

JJD2=JD2-JJCNT  FE100249 

J JD2  P 1 =J JD2+ 1 P F 1 00  250 

IF (IPFT (5) . EQ.O) GC  TO  356  FE100251 

WRITE (6,42)  XT (K)  ,K  RE100252 

FORMAT  (1H0,5X,5HTIHE=,E1 1.4,3X,2HK=,I3)  RE  100253 

CALCULATE  TEMPFF  AT  IJFE  PISE (MATRIX  REDUCTION  ALGORITHM)  RF100254 

COIUMNS  (NORMAL) RE100255 

IK= 1 PE100256 

DO  45  1 = I PA , M RF100257 

W=XX*VSH (I|/DT  PEI  00258 

DO  44  J= 1 , N FE10C259 

FXC(J)=W*CON(I)*B(J,2)-BV(J,2)*IV(I)-BB*IAb(:,J)  FE100260 

I F ( J . GT.  1 ) FXC  (J ) =FXC  (J)  ♦ (CON  (I)  *B  (J  , 1 ) ♦ BV  ( J , 1 ) * IV  ( I)  ) *C XC  (21- 1 ) I FI  00261 
CXC (J) =-  (CON (I) *B (J,3) *BV (J, 3) *IV (I)  ) /PXC (J)  RFl 00262 

SUM= (W- (A (1,2) -BV  (J,2) *IV  (I) -BB*IA3  (I, J) ) ) * V (I,J)  *A  (I,  1) • V (1-1  , J)  ♦ I El  00 263 
1A (1,3) *V (1+1, J) + S (I, J)  FE10026U 

DXC (J) =SUM/FXC (J)  F F 1 00  265 

IF (J.GT. 1) DXC  (J) - (SUM+  (CON (I) *B ( J , 1 ) ♦BV (J , 1 ) * IV ( I)  ) • DXC { J- 1)  ) /FXC ( F E 1 00 266 
1J)  F E 1 00267 

CONTINUE  FF100266 

VX=0.  RE100269 

DO  45  L= 1 , N FE100270 

J=N+ 1 -L  BE100271 

VX  = DXC  (J) -CXC  (J) *VX  PEI  00272 

VXX(I,J)=VX  PEI  00273 

DO  46  1 = 1 PA , M PEI  00274 

DO  46  J= 1 , N FF100275 

V (I, J) =VXX  (I,J)  PE  1 00 276 

BOWS  ( NOHH  AL) RE100277 

CXR (IPA-1) =0.  PE1C0278 

DO  50  J = 1 , N PEI  00279 

DO  48  I=IPA,M  PF10C280 

W = XX* VSH  (I) /DT  RFl 00281 

FXF  (I) =W  + A (1,2) -BV  (J,2) *IV (I) -BB*I.\B (I , J)  ♦ A (I , 1 ) *CXP (I- 1 ) PFl 00282 

CXF  ( T ) =- A (I,3)/FXP  (I)  FE100283 

SUM= (W- (CON (I)*B  (J,2) -BV  (J,2) *IV (I) -BB*TAB  (I, J1 ) ) »V  (I , J) ♦ (CON  (I) * FT1 00284 
1B(J,3) +8  V (J  , 3) * I V (I) )*V  (T , J*  1 ) *$ (I , C)  EH  0026  5 


IF (J . GI. 1 ) SUM=SUM+ (CON (I)  *B  (J,1)  *BV  (J,  1)  *IV  (I)  ) *V  (I,J-1) 

DXP  (I) =SUM/FXR  (I) 

IF (I.GT. It  A) DXB  (I)  = (SUN* A (1,1) *DXB (1-1) )/FXR (I) 

4b  CONTINUE 

VX  = 0. 

DO  50  L=IPA,K 
I=M+IPA-L 

VX  = DX  R (I) -CXB  (I) *VX 
VC  (I,J,K) =VX 

50  VXX  (I,J) =VX 
DO  51  I=IPA,M 
DO  51  J = 1 , N 

51  V (I,J) =VXX  (I,J) 

IK= IK  ♦ 1 

C »♦*  RECYCLE  TEMPERATURE  CALCULATIONS 
IF (IK.LE. IK  X ) GC  TO  43 
IF (K. EQ. KM) GO  TO  62 

IF (ITYPEX. LT. ITYPE. AND.K. LT.KT) GO  TO  66 
o2  IP (IPFT  (5)  . FQ.C) GO  TO  357 
WRITE  (6,63)  (B  (J)  , J=JD1,JD2) 

63  FORMAT  (1  H , 13X,  2HF.= , 9F1 3.  5/1 H , 15X,  30H 

1--) 

DO  65  I=ID1,ID2 
X1=Z  (l)-z  ( I PF ) *DZ/2. 

IFfJCNT.GT.  9)  GO  TO  57 

WRITE  (6,64)  XI , (VC  (I , J,K)  , J = JD1 , JD2) 

GO  TO  65 

57  WRITE  (6,64)  XI  , (VC(I,J,K)  ,J=JD1,JJD2) 

WRITE  (6,64)  XI,  (VC  (I,  J,K)  , J=JJD2P1 , JD2) 

64  FORMAT  (1 H , 3X , 2HZ= , F8 . 5 , 2 X , 1 P9E 1 3 . 6) 

65  CONTINUE 
357  ITY PEX  = 0 

66  K=K+1 
ITYPEX=ITYPEX+1 

IF  (K. LE. KT) GO  TO  38 
ITYPEX=ITYPE 

IF (IPRT(6) . EQ. G) GO  TO  365 
WRITE  (6,320) 

320  FORMAT  (1  HO , 20HNORMALIZED  TEMPERATURE  RISES) 

DO  70  K=2 , KT 

IF (K. EQ. KM) GO  TO  67 

IF (ITYPEX.LT. ITYPE. AND.K. LT.KT) GO  TO  70 

67  X 1 = 1 . 

WF.ITE(6,321)XT(K)  ,K,X1 

3 21  FORMAT  (1  HO , 5X , 5HTIM E= , El  1 . 4, 3X, 2HK  = , 13, 3X , 6HPO WER  = , E 1 1 . 4 , 5H WATTS) 
WRITS  (6,6  3)  (R  (J)  ,J=JD1,JD2) 

JCNT= JD2-JD1+1 
IF (JCNT.GT. 9) GO  TO  380 
GO  TO  381 

380  JJCNT=JCNT-q 
JJD2=JD2-JJCNT 
J JD2P 1 =J J D2  + 1 

381  DO  69  I=ID 1 ,ID2 
DO  68  J= JD 1 , JD2 

68  V (I,J) =VC  (I,J,K)/POW 
X1  = Z (I) -Z  (IPE) +DZ/2. 

IF  (JCNT.GT. 9) GO  TO  382 


PF100286 
RE100287 
RE100288 
PEI  00289 
RE100290 
PEI  0029 1 
RE100292 
R F 1 0029  3 
RE100294 
RF100295 
RE100296 
RF100297 
RE  1 00298 
RE100299 
RF100300 
RE100301 
RE100302 
RE100303 
RE100304 
FE100305 
EE100306 
PE100307 
PEI  00308 
PE1003C9 
EE10C310 
R El  003 1 1 
PF1C0312 
PE10031 3 
P El  003  1 4 
RE100315 
PEI  00  3 1 6 
P E 1 00  3 17 
RE  1 003 1 8 
RF100319 
PF100320 
RE100321 
P F 1 00  322 
PF100323 
RE1 00324 
RF100325 
PE1C0326 
RE100327 
PE  1 00  328 
PEI  00329 
PE  1 00330 
RE  1 003  31 
R E 1 00  332 
P F 1 00  33  3 
P El  00334 
RF100335 
P El  00  336 
RF100337 
RE100338 
FE100339 
PEI  00340 
R El  0034 1 
RE  1 00  342 


WRITE  (6,64)  XI,  (V  (I, J)  ,J  = JD1,JD2) 

GO  TO  69 

38  2 WRITE  (6,64)  XI  , (V  (I, J)  ,J=JD1,JJD2) 

WRITE  (6,64) XI,  (V  (I, J)  , J= JJ D2P 1 , JD2) 

69  CONTINUE 


E E 1 00  34  3 
PEI  00344 
RE100345 
PE1C0346 
PEI  00347 


70 

C *** 

c * »* 

330 


IT Y PFX  = 0 
ITYPSX=ITYPFX+1 

READ  NORMALIZED  TEHPFP ATURE  RISES  TS  OP  GRANULES  FOP 
CALCULATE  NORMALIZED  PISES  XPD  FOR  ACTUAL  PULSE 


3E-8  PULSE 


FF1C0348 
RE100349 
PEI  00350 
PEI C 0351 


FOFMAI  (1  HO, 61 HDIMENSION  OF  ARRAYS  ASSOCIATED  WITH  ARGUMENT  LIJ  IS  RE100352 


1 TOO  SMALL)  FE100353 

365  READ  (5,8) LTMAX  FE10035U 

DO  71  L1=1, LTMAX  PE100355 

71  TS  (LI ) =1 . PEI  00356 

RE  A.  D (5,2)  (TS  (L)  , L=  1 , LTMAX , 1 0)  PF100357 

CALL  MXGRAN  RE10035B 

DO  72  L= 1 , KT  RE1 00359 

72  XPD(L)=AP*XPD(L) ♦ 1 . - AP  RE10036C 

READ  (5,4)  (DAMAGE  (L2,1)  , DA M AGE (L2 , 2)  ,L2=1,2)  .TSTEAM , DTSTM  RE1 00361 

WRITE  (6,7  3)  WAVEL, TSTEAM,  DAMAGE  (1  , 1)  , DAM  AGE  (1,2)  , DAM  AGE.  (2,1),  RE  10036  2 

1 DAMAGE (2,2)  RF100363 

7 3 FOFKAT  (1 H0,5X, 1 1 H WA VELENG?H= , F7 . 1 , 2HNM , 3X ,7 HTSTEAM  = , F6 . 0 , 3X , 7 HD AM ARE1  003  64 
1 GS  = , 4F9. 0)  PEI  00365 

C **«  CALCULATE  I,J  INDICES  AT  WHICH  DAMAGE  CALCULATIONS  APE  TO  BE  MADE  RF100366 


JM  = 0 

PEI  00  367 

DO  74  J=  1 , N 

RE100368 

IF  (R  (J) . LT. PM AX+ .000001) JM=J+1 

FE1 00369 

74 

CONTINUE 

R E 1 00  37  0 

X1  = 0. 

PEI  00  37 1 

DO  75  I=IPA,M 

RE1C0372 

IF  (VC  (I, 1 , KM)  .GT. XI) IHAX=I 

RE100373 

IF  (VC  (I, 1 , KM)  .GT. XI) X1=VC (1,1 , KM) 

PEI  00374 

75 

CONTINUE 

RE100375 

L = 0 

F E 1 00  376 

GO  TO  (366,367,368) ,HAXPRT 

RF100377 

366 

LIMAX  1 = 2*LIMAX 

RF100378 

LIM AX2=0 

RE100379 

GO  TO  369 

R El  00  39 0 

367 

LIMAX1=LIMAX 

RE100381 

LI M A X 2 = L I MAX 

PEI  00382 

GO  TO  369 

RE  1 00  38  3 

368 

LIMAX 1 =0 

PE100384 

LIMAX2=2*LIHAX 

RE100385 

369 

ID1=IMAX-LIMAX1 

RE100386 

ID2=IMAX+LIHAX2 

P E 1 00  387 

IF(ID2.GT.28) ID2=28 

PEI  00388 

DO  76  I=ID1 ,ID2 

RE100389 

DO  76  J= 1 , JM 

PEI  00390 

L = L ♦ 1 

RE100391 

ID  (L)  =1 

RE100392 

76 

JD  (L) =J 

RE100393 

LI J= (ID2-ID1+1)*JM 

PEI  00394 

DO  385  LL  15  = 1, 10 

RE100395 

385 

SAVRGV  (LL 1 5) =0. 

PEI  00396 

IF  (LPX. EQ. 0) GO  TO  125 

PE100397 

IF  (LIJ . GT. 2 7) WRITE (6,3  30) 

RE1 00399 

IF (LIJ . GT. 27) GO  TO  300 

0039° 

68 


IF (IPBT(fl) . ?y.P) GC  TO  370 

* «*  TFMPSFATUFF  AND  DAM AGF  EVALUATIONS  FOR  MULTIPLE  TULSFS 


*»»  EVALUATE  IEMPESATUFE  PISES  WITH  AND  WITHOUT  GRANULES 
DO  77  L= 1 , L J J 
I=ID(L) 

J=JD  (L) 

VE(L,  1, 1)  =0. 

VML,1,2)=0. 

DC  77  K=2 , XT 

VE (L, K , 1 ) =VC  (1,J,K) 

VE ( L , K , 2 ) =VC  (I ,J , K) 

IF  (I. NE. IG) GO  TO  77 
VF(L,K,2)=XPD(K)*VC(I,J,X) 

IF (VE (L,K, 1) .LT. . C) VE  (L,K, 1) =0. 

IF(VE(L,K,2) .LT..0) VE(L,K,2)=0. 

77  CONTINUE 

X6C=(XC-1.)/D'.:X 
X6 1 = A LOG  ( XC) 

X5TEA  M=TSTFAM 
>7C  LI  3 = 0 
371  L 1 3=L 1 3 ♦ 1 


P E 1 00400 
P E 1 0040  1 
RF100402 
B E 1 00  40  3 
R E 1 00404 
P E 1 00405 
PF100406 
PEI  00407 
PF1 00408 
E r1 00409 
RE1 00410 
F El  004  1 1 
FF100412 
PF10041 3 
PFl 0041 4 
EE10041S 
P E 1 004 1 6 
PF100417 
RF10C41  3 
PFl 00414 
PF 1 00420 
PEI C0421 


X3=DPULSE+ (N PULSE (LI  3) - 1) /KEPFT  (LI  3)  PEI  00422 

WFTTF (5,78) N RUN  (LI  3)  , X 3 , X DPULS , N PULSE  (L  1 3)  , K£PET(L13)  PF1G0423 

78  FOR  MAT  (1H0, 5X,5IINFUN  = ,I3,2X,  13HTPAIN  LENGTH =, E 1 0 . 3 , 3HSEC , 2 X , 1 2H PULP E 1 00 4 24 

1 SE  WIDTH=*E1C.3, 3HSEC/1H  ,5X, 17 H NUMBER  OF  PULSES= , 1 5, 3X , 1 6HF EPETI TREl 00«2 5 
2 ION  RATE=,E1C. 3, 10 H PULSES/SEC)  EE1C0426 

IF  (IFIL. EQ. 0) GO  TO  80  PF100427 

WFITE  (6,7  9) PIM, LESION  PE1C0428 

79  FOP  SAT  ( 1 H ,5X,12IibFAM  RADI US  = ,E10. 3, 2HCM,5X,14H LESION  E ADI US  = , F 1 0 . F E 1 00 429 

13.2HCK)  PF100430 

GO  TO  82  RE1C0031 

80  WRITE  (6,81) PIM, LESION  RE100432 

81  FORMAT  (1 H ,5X,13HIMAGE  PADIIJS  = , 310. 3,2HCM,5X, 14 H LESION  R A DI US= , El  OF E 1 00 4 33 

1.3.2HCM)  P E 1 004  34 

82  IF  (IPHT  (8)  .FQ.O) GO  TO  108  FF100435 

TC=1. /KEPFT  (L13)  PEI  00436 

N PL=  N PULS  E (L 1 3)  FF100437 

KX  = N P+  3 EF100438 

I N= 1 E F 1 00  4 39 

63  IF (NPL/IN.LT. 20) GO  TO  84  FE100440 

I N= IN ♦ 2 FF100441 

GO  TO  83  P F 1 004 42 

84  X 1 =NPL  F.E100443 


I N X = • 5 + X1/TN 

Ll=ALOG(DPULSE)/. 693 15+29. 

IF (LI .LT. 1) L1=1 
I NX  X = FTI ME  (LI) *INX 

•*»  STORE  TIMF  INTERVALS  AND  LOGS  OF 
ZTX  (1 ) =PTISE 
ZT  (1) =PTIME/2 . 

ZTT  (1) = A L OG  (IN^PTIME) 

DO  85  L 3 = 2 , N P 

ZTT  (L3) = ALOG  (IN'PTTMF) 

ZTX (L3) =ZTX  (L3-1) +PTIHE 
65  ZT(L3) = ZT  (L3-1) +PTIMF 
L 1 = N P + 1 


P E 1 004  44 
PR  100445 
PEI  00446 
F E 1 0044  7 

INTEFVALS  FOF  DAMAGE  CALCULATIONS FE 1 0044 8 

F.F100449 
PFl 00450 
FE10045.1 
F E 1 00452 
PE100453 
PF100454 
FF10045S 
PFl 00456 


i 

1 1 


i 

" ' -4  . 


^iv 

II 

1 I 


8b 

* »* 


87 


88 


90 


91 

93 


94 

95 

*** 
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X 3=  (TC-DPULSS) / (KX-NP) 

ZTX  (LI) =DPULSE+X3 
Zr  (L1)=DPULSE+X3/2. 

ZTT  (LI) = ALOG  (IN*  X3) 

L 1 = L 1 ♦ 1 

DO  86  L3=L1,KX 
ZTT  (L3) =ALOG  (IN*  X3) 

ZTX  (L3) = ZTX  (L3-1) + X3 
ZT  ( L3 ) =ZT (L 3- 1 ) ♦ X 3 

CALCULATE  TEMPERATURE  PISES  ASSOCIATED 
FOLLOWING  (L6-. 5) »IN-. 5 PULSE 
DO  95  L=  1 , LI  J 
DO  95  L 3 = 1 , K X 

XI  = 0. 

X 2 - 0 . 

Ll=1+TN/2 
L7=  1 

X 3=  ( L 7 — 1 ) -TC  + 7.T  (L3) 

K=ALOG  (X3*  XbO+1. )/X61+1. 

X5  = V E (L, K, 1) ♦ (X3-XT (K) ) * (VE(L,K  + 1, 1)  -VE (L,K, 
X1=X1 + X5 

X3=  ( L 7 — 1 ) ‘TC+ZTX  (L3) 

K = ALOG  (X3*X60+1.)/X61+1. 

X2=X2+VE(L,K,2)+  (X3-XT  (K) )*(VE(L,K  + 1,2)-VE(L 
IF  (X6 . LT . . 000 1 * X 1 ) GO  TO  88 
L7=L7+ 1 

IF  (L7.LE.L1) GO  TO  87 

VZ  (L, 1 , L3 , 1) =X1 

VZ  (L, 1 ,L3,2) = X2 

DO  93  L 6 = 2, INXX 

IF  (X5.LT. ,0001*X1)GO  TO  91 

XI  = VZ  (L,L6-1,L3, 1) 

X2=VZ  (L,Lfc-1,L3,2) 

L2=L 1 ♦ 1 

L 1 = LI +1 N 
L7=L2 

X 3=  (1.7-1  ) * TC+  ZT  (L3) 

K=ALOG(X3*X60+1.) /Xt 1+1 . 

X5=VS (L,K, 1) ♦ (X3-XT(K) ) « 

X 1 =X 1 +X5 

X 3=  (L7-1) * TC  + ZT  X (L3) 

K = ALOG  (X3*  X60+1. )/X61  + 1. 

X2  = X2+V5.  (L,K,2)  ♦ (X3-XT  (K)  ) * (VE(L,K+  1, 2)  -VF  (L 
IF(X5.LT..OC01*X1)GO  TO  91 
L7=L7+ 1 

IF  (L7.LE.L1) GO  TO  90 
VZ  (L,L6,L3, 1) =X1 
VZ  (L,L6, L3, 2) =X2 
L1=INX+ 1 

DO  94  Lo  = L 1 , IN  XX 
L8  = L6-IN  X 

VZ(L,L6,L3,1)=VZ(L,L6,L3,1)-VZ(L,Lft,L3,1) 

VZ  (L,L6,  L3,2)  =V7.  (L  ,L6  , L3 , 2 ) - VZ  (L,L9,L3,2) 
CONTINUE 

DAMAGE  CALCULATIONS  

WHITE  (6,375) 

FOP  MAT  (’ HO , 31 HPb  EDICTED  THRESHOLD  LASER  ^OVE 


WITH  L3-TH  TIME  INTERVAL 


RE100457 
P FI  00  458 
RE1C0459 
R El  00460 
RF100461 
KE100462 
RF100463 
PE1C0464 
PEI  00465 
FE1 00466 
E F 1 00  467 
PF100468 
PE100469 
R E 1 00470 
PF100471 
RF100472 
PEI  00473 
F FI  00474 
FE100475 
P F 1 004  76 
PEI  00477 
FE100478 
RE100479 

,K,2)  )/ (XT (K+1) -XT (K) ) FF100  480 

F.F100481 


1))/(XT(F  + 1)-XT(K)) 


(VE(L,K+1, 1) -VE(L,K, 1) )/(XT (K+1) -XT (K) ) 


FF100482 
RF100483 
R El  00484 
Rt 1 00485 
FE100486 
PE100487 
r El  00488 
FE1 00489 
FE100490 
F E 1 0049 1 
PF100492 
P F 1 0049  3 
PF10C494 
RE1 00495 
RF100496 
RF100497 
FE1 C04QH 

,K ,2) ) /(XT (K+ 1) -XT  (K) ) PEI  00499 

FE1005CC 


PEI  00501 
PEI  00502 
RF1C0503 
RF 1 00504 
RF1005C5 
R F 1 00  506 
RF100507 
F F 1 00  508 
RE100509 
PEI  00510 
R El  0051 1 
P El  CO  5 1 2 
FE10051 3 
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TSTEAM=XSTEAM 

XQ=0. 

96  WFITE  (6, 130) TSTEAM 
DO  104  L= 1 , LIJ 
I = ID  (L) 

J=JD  (L) 

IF (VZ (L,INX,NP, 1) .LT. .001) QD (I.J) =1.E*20 

IF (VZ  (L, INX, NP, 1 ) .LT. . 001) GC  TO  104 

1,9=  10.*  (,4+LXP  (-.CC14*DPULSE)  ) /V  Z (L  , IN  X , N P , 1 ) 

CQ=L9* 1 . 

X 10=70.*  (.4  + EXP  (-.0014*DPULSE) ) /VZ (L,I MX, NP,1 ) 

IF (L9.FQ.0)  CQ=X10 
LI.T  = 0 
LGT  = C 

99  DAHC=0. 

1.6  = 1 

100  DC  101  L3= 1 , KX 
X3=0. 

IF (VZ  (L,L6,L3,2) *CQ. GT . TSTEAM-TO)  X3=1.E+30 
IF(VZ  (L.L6.L3.2)  *CQ.GT. TSTEAM-TO)  GO  TO  101 

X 5 C = V Z (L,L6,LJ,1) *CQ+273.*T0 
IF (X50.LT. 317.) GO  TO  101 

XI  = ZTT (L3) ♦ DAM  AGE (1 , 1) -DAMAGE  (1 ,2) /X5C 

IF (X50.GT.323.) X1=ZTT  (L  3) + DAMAGE  (2 , 1 ) -D AM  AGE (2 , 2) /X5C 
IF (XI .GT. 0. ) X3= 1 .01 
IF (XI .GT. 0. ) GO  TO  101 
X3=EXP  (XI) 


PF10C514 
F E 1 005 1 5 
R El  005 1 6 
F El  005 1 7 
RE100518 
E El  005 1 9 
PEI  00520 
EE  1 00521 
PEI  00522 
FE100523 
EE100524 
P F 1 00  525 
P E 1 00526 
PEI  00527 
FE100528 
RE  1 00529 
EE100530 
PF100531 
PEI  00532 
FF100533 
PE100534 
RE100535 
PE  1 00536 
P E 1 00  537 
F El  00538 
PEI  00539 
PEI  00540 


101  DAMC  = DA»OX3 

IF  (DAMC. GT.  1 . ) GO  TO  102 
C ***  INCPEASE  TIME  INDICES  AND  CONTINUE 
Lfc  = L6 ♦ 1 

IF  (L6 .LE. INXX) GO  TO  100 

C ***  ADJUST  LASER  POWEF  TO  YIELD  THRESHOLD  DAMAGE  AT  GIVEN  PCINm 
IF(LGT.EQ.1)CO=1.02*CQ 
IF (LGT. EQ. 1) GO  TO  103 
LLT=  1 

CQ=1 . 04*CQ 

GO  TO  99 

102  IF(LLI.IQ. 1)CQ=.98*CQ 
IF (LLT.3Q. 1 ) GO  TO  103 
LGT=  1 

C 3= .96*00 
f,  J TO  O'3 

103  yD  (T, J) =CQ'POX 

104  CONTINUE 

VP  ITS  (6,63)  (F (J)  ,J=1,JM) 

T)0  97  I=ID1,ID2 
DO  97  J=1,JM 
97  XOD  (I.J) = 00  (I.J) «XXO 
DO  10b  1 = 11)1, ID2 
X1=Z  (I) -Z  (IPE) *12/2. 

IF  (JM.GT.9) GO  "0  98 

WRITE  (6,105) XI,  (XQD  (I.J)  ,J=1 , J M) 

GO  TO  106 

99  VP  ITU  (6, 105) XI  , (XOD  (I, J)  ,J=1 ,9) 

WPITE  (6,  1C5)  XI , (Xt’D  (I,  J)  ,J  = 10,JM) 

105  FOE  MAT  (1  if  , , 2112  = , F7. 5 , 1 X , 3HQD  = , 1 PSE 1 3 . 6) 
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P E 1 0054 1 
PEI  00542 
PE10C543 
RE100544 
PEI  00545 
R E 1 00  54  6 
EE  1 00547 
PE100548 
R E 1 00  54  9 
FE10C550 
Fr1 00551 
E El  00552 
PEI  0055  3 
I El  00554 
PE100555 
EF1 C055b 
E El  00557 
F.F1C055P 
PEI  00559 
PF100560 
F E 1 00  56  1 
PEI  00562 
PE  IOC  56 3 
FE1 00564 
PEI  00565 
PEI  00566 
EE1CC567 
PE100568 
? E 1 00569 
F E 1 00  S'7  0 


1 Oo 

CONI INU? 

RE100571 

x2=  (xo-;d(x«ax,1) )/QD(inAx,i) 

RE  1 00572 

X 1=X„*X2 

PEI  0057  3 

I F ( X 3 . LT . . 3 0 C 1 ) GO  70  108 

RE  1 09574 

TST  E A (1=7372 AM+D^STM 

R E 1 00  575 

XU=QD  ( I *1 A X , 1) 

P E 1 00  576 

GO  TO  96 

R F 1 00577 

1 06 

IF  (KTYPL . EQ. 0)  GO  70  174 

P El  00578 

C »*» 

calculate  AND  STOI-F  (MULTIPLE  PULSE  EXPOSURE)  temperatures  fop 

RE  1 0057  9 

c * »* 

PLOTTING  PROFILES 

PEI  00580 

7C= 1 . /RKPFT (L 1 3) 

PF1C0581 

NPL=NPULSE (L 1 3) 

RF.100582 

HFITF  (6, 1 39) 

RE100583 

DO  123  L 1 5= 1 , KT YPF 

RF100584 

IF  (TIMEX  (L15) .GT.XT (KT) ) GO  TO  123 

RE100585 

RGV  = 0 . 

RE1 00586 

L2  = TI MFX (115)  /TC 

RE100587 

DTIMF=TIM: X (LI 5)  -L2* TC 

RF100568 

L2=L2+ 1 

R El  00  585 

DO  116  1=111,112 

PEI  00590 

DO  116  J-JJ 1 , JJ2 

RE100591 

X 1 =0 . 

R F 1 00592 

DO  113  L 6= 1 , L2 

PF100593 

K = ALOG  ( (DTI  ME*  (L6-1) *TC) *X6G+ 1 . ) /X6 !♦ 1 . 

RE100594 

X2= (DTIME*  (L6-1) *TC-XT  (K) ) / (XT (K+ 1) -XT (K) ) 

PEI  00595 

113 

X1  = X1 4VC  (I,J,K) *X2*  (VC  (I,J,K»1) -VC(I,J,K) ) 

PEI  00596 

V (I, J) =X1 

FE100597 

L3=L2-NPL 

RE100598 

IF  (L3.LE.0) GO  TO  115 

R F 1 0059  9 

X1  = 0. 

EE100600 

DO  114  L6= 1 , L3 

PE1006C1 

K=  ALOG  ( (DTIKE+  (L6-1)  *TC)  * X60  + 1 . ) /X6  1 ♦ 1 . 

PF100602 

X2=  ( DTIM  £♦  (Lfc-1) *TC- XT  (K) ) / (XT ( K ♦ 1 ) -XT (K) ) 

RE100603 

1 14 

Xl  = X 1 +VC  (I, J,K) +X2*  (VC  (I,J,K+1) -VC  (I,J,K) ) 

RE1006C4 

V(I,J)=V(I,J)-X1 

PEI  00605 

115 

IF  (V  (I , J)  .GT.RGV) FGV=V (I,J) 

RE1006C6 

116 

CONTINUE 

RE1006C7 

SAVFGV  (Li  5) = RG V 

RE1 00608 

IP  (KTYPEO. EO. 1) GO  TO  121 

FF100609 

WRITE  (7, 1 17) NRUN  (I  13)  , N PULSE (LI  3)  , REPET  (LI  3) 

PF100610 

117 

FORMAT  (2  17,  F.  1C.  4) 

RE100611 

WRITE  (7,  lid) XDPULS,WAVEL,BIM 

RE  10061 2 

1 16 

FORMAT  (7E 1 1 . 4) 

RE100613 

WRITE  (7, 1 14) I1 1,112, II3,JJ1 ,JJ2 

PF10061 4 

1 1“ 

FOF  MAT  (517) 

RE10Q615 

WRITE  (7, 1 19) N3, M3 

RE100616 

WRITE  (7, 1 20)  (P  (J)  ,J  = 1 ,N3) 

RE100617 

120 

FOPMAT  (10F8.4) 

RE100619 

WRITE.  (7,  120)  (Z  (I)  ,1  = 1 , M3) 

FE10061  9 

WPITF  (7, 1 16) TIMEX (L15) 

RF100620 

121 

WRITE  (6, 1 4 1 ) TIMEX (L15) 

RF100621 

WRITE  (6,63)  (R (J)  ,J  = JJ1, JJ2) 

RE100622 

JCNT  = JJ2-JJU1 

PF1 0062  3 

IF  (JCNT.GT.9) GO  TO  390 

FE100624 

GO  TO  391 

RE  1 00625 

390 

JJC  NT  =JCN7-° 

PE100626 

JJJ2=JJ2-JJCT’ 

P El  00627 

J.7J2P1=JJJ2+1 

RE109628 

391 

nn  122  1=111,112 

PE100629 

X1=Z  (I)  -Z  (I PE) ♦ DZ/2 . 

FE100630 

IF  (JCNT.GT. 9) GO  TO  392 

PEI  006  3 1 

WRITE  (b, 64) XI, (V  (I,J)  ,J  = JJ1 ,JJ2) 

FE100632 

GO  TO  393 

PE100633 

392 

KFITE (6, 64) XI , (V  (I  ,J)  ,J  = JJ1 ,JJJ2) 

9E100634 

WRITE  (6,64) XI,  (V  (I, J)  , J=JJJ2P1 , JO 2) 

RF100635 

3 93 

IF  (KTYPEO. EQ. 1) GO  TO  122 

F.  E1C0636 

WRITE (7,137)  (V  (I , J)  ,J  = JJ1,JJ2) 

PF100637 

1 22 

CONTINUE 

PEI  00636 

123 

CONTINUE 

F El  00639 

F.  G V = 0 . 

F E 1 006<4  0 

TO  395  LL15=1 ,K"Yrr 

PE100641 

IF (SAVRGV ( LL 1 5) .GT.RGV) PGV=SAVFGV  (LL 1 5) 

FE100642 

3 95 

CONTINUE 

F F 1 0064  3 

WRITE  (7,39*5) 

F E 1 00644 

3 9b 

FORMAT  (22  UNA  X RGV  CARD  (3)  FOLLOW) 

FF100645 

DO  397  LL15=1 ,KTYPE 

PE100646 

3 97 

KRITF (7, 137) PGV 

F E 1 CO 64 7 

GO  TO  174 

RE100643 

1 24 

FORMAT  (1H  ,5X,1P9F13.6) 

FE1C0649 

1 37 

FORMAT  (6F1 3.6) 

PF.100650 

1 39 

FOFMAT  (1HC, 35HTEHPEPATURE  FISES  AT  SELECTED  TINES) 

PEI  0065 1 

1 4 1 

FORMAT  (1H0,5X,5HTIME=,E11.4) 

FE100652 

1 4 S 

IF (LI  3 . EQ. N TEST) GO  TO  300 

FE100653 

GO  TO  371 

FE100654 

* • * 

DAMAGE  CALCULATIONS  FOR  SINGLE  PULSE 

FF10C655 

1 *4 

WRITE (6, 126) SPUN (1) , XDPULS , NPULSE (1) 

P E 1 00657 

lit 

FORMA!  (1  HO, 5X , 5HN R UN  = ,1 3 , 2X , 1 2HPULSE  WIDTH®, E10 . 3 ,2X , 1 7 HNUHBEF 

OF  RE100656 

1 PUI SES  = , 15) 

R E 1 0065  9 

IF (IFIL.EQ.C) GO  TO  127 

R El  00660 

WRITE  (6,79) PIN, LESION 

PEI  0066 1 

GO  TO  123 

PE100662 

127 

WRITE  (b, 31) FIN, LESION 

EE  10066 3 

1 -6 

IF (IPRT (3) . EQ.O) GO  TO  150 

FE1 006b4 

WRITE (6,375) 

RF100665 

XQ=0. 

RE  1 00666 

1 2° 

WRITE  (0, 1 30) TSTZAH 

PEI  00667 

1 3 C 

FORMAT  (1H0,5x,7l!TSTEAM=,F7.0/1H  ,5X,10H ) 

RE100668 

DO  133  I=ID 1 , I D2 

PEI  00669 

DC  138  J = 1 ,0 M 

PEI  00670 

IF(VC(I,J,KM).LT..001)QD(I,J)=1.0E+20 

PE  1 0067 1 

IF  (VC  (I,  J,K.V.)  .LT.  .001)  GO  TO  138 

RE100672 

L9=1C . * (. 4+EXP (-.001 4*DPULSE) ) /VC (I , J, KM) 

RE100673 

CQ=L9 ♦ 1 . 

PEI  00674 

XI 0=70.'  (.4+EXP  (-. C014*DPULSE)  ) /VC (I, J, KM) 

RE100675 

IF  (L9.EQ.0) CQ= X 1 0 

PEI  00676 

LLT  = 0 

P FI  00677 

LGT  = 0 

E E 1 00678 

131 

DA  MC  = 0 . 

RE100679 

K = 2 

RE  1 00680 

132 

XI  3 = A LOG (XT (K) -XT (K-1) ) 

PEI  00681 

VPX= (VC ( I , J , K) ♦ VC (I,J,K-1)  )/2. 

RE  100682 

X3  = 0. 

P E 1 00683 

IF (I. NE. IG) GO  TO  1 33 

F El  00684 

73 


I P ( V • X * KPD  ( K) *CQ.GT. TSTEA1-TC)  X3=1 . F*30 
i P (VPx»XPD  (K ) *C0.GT.TST!A1-T0) GO  TO  134 
133  * 60  = VPX  «CQ«’273.  *TC 

IP (XS0.LT.317.JGO  TO  134 

X1  = X’ 3* DAB AGE  (1 ,1) -DAMAGE  (1 ,2) /X50 

IP  (X50.GT. 323.)  X1=X 13+ DAMAGE  (2,  1)  -DAMAGE  (2, 2)  /X50 

IP  (XI .GT.O.) X3= 1 . 01 

IF  ( X 1 .GT.O. ) GO  TO  134 

X 3=  EX  P (XI) 

1 14  DAHC=DAMC+X3 

IF  (DAMC.GF.  1.)  GO  TO  135 
K = K*  1 

IF(K.LT.KT) GO  TO  132 

C »**  ADJUST  LASFE  POWEP  TO  YIELD  THRESHOLD  DAMAGE  AT  GIVFN  POINT 
IF (LGT.EO. 1) CQ=1 .02*CQ 
IF ( LGT . TQ. 1 ) GO  TO  136 

LL?=  1 

CQ  = 1 . 04*CC> 

GO  TO  131 

135  IP (LLT.EQ. 1) CQ=.96*CQ 
IP(LLT.EC. 1 ) GO  TO  136 
LGT=  1 

CQ=. 96*CQ 
GO  TO  131 

1 36  QD(I, J) = CQ*  POX 
138  CONTINUE 

WRITE  (6,63)  (R (J)  , J = 1 , JM) 

DO  140  I = ID 1 , ID  2 
DO  140  J= 1 , JN 
140  XQD  (I,J)=QD  (I,J)*XXQ 
DO  143  I=ID1,ID2 
X1=Z  (I)-Z  (IPE) +02/2. 

IF  (JM.GT. 9) GO  TO  142 

WRITE  (6, 105) XI  , (X0D(I,J)  ,J=1,JM) 

GO  TO  143 

142  WPITE  (6, 105) XI,  ( X 0 D (I , J ) ,J=1,9) 

WRITE  (6, 105) XI , ( X C D (1,0)  ,J  = 10,JM) 

143  CONTINUE 

X2=  (XQ-QD  (IMAX,  1)  ) /QD  (I  MAX, 1) 

X 3=  X2*X2 

IF  (X3.LT. .0001) GO  TO  150 
TSTEAH=TSTEAM*DTSTM 

Xy  = QD  (IMAX, 1) 

GO  TO  129 

150  IP (KTYPE. EQ.O) GO  TO  174 

C ***  CALCULATE  AND  STORE  (SINGLE  PULSE  EXPOSURE)  TEMPERATURES  FOR 
C PLOTTING  PROFILES 

WRITE(6,139) 

DO  170  L15=1,KTYPF 
PGV=0. 

DTIHE  = TIMEX  (L 1 5) 

K = ALOG (DTIME*  (XC- 1 . ) /DTX«- 1 . ) /ALOG  (XC) ♦ 1 . 

IF  ( K ♦ 1 .GT.KT) GO  TO  170 

XI  = (DTIME-XT  (K) ) / (XT ( K ♦ 1 ) -XT (K)  ) 

DO  166  1=111,112 
DO  166  J=JJ  1 , JJ2 

V (I,J)  = VC  (I  , J , K ) ♦ X 1 * (VC  (T,J,K*1)  “VC  ( I , , K ) ) 


?r 1 00686 
RF1C068H 
R F 1 0068  7 
R FI  00688 
P El  0068  u 
R El  00690 
PEI  0069 1 
PEI  0069? 
R El  00693 

F F 1 00694 
F E 1 0 069  5 
PE1C0696 
FF1C0b97 
RE100698 
PE1C 0699 
F El  00700 
F E 1 0070 1 
R FI  00702 
PEI  00703 
R E 1 00704 
F FI  00 705 
RE 1C07C6 
RF100707 
f F100708 
F FI  00  709 
RE10071C 
FF100711 
PEI  00712 
RF10G713 
PE10G714 
PEI  00715 
FF100716 
R El  007  1 7 
F E 1 00  7 1 6 
FE 1 007  1 4 
RE100720 
P E 1 0072 1 
F E 1 00  722 
R El  00723 
FE107724 
PEI  00726 
PF100726 
R El  00727 
RE100728 
RE100729 
R El  007 30 
PF.100731 
RE1007  32 
RE100733 
PE100734 
PF100735 
PF100736 
PE1C0737 
RF100738 
RF100739 
PF1 00740 
7F100741 
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C * *» 

174 


IF  (V  (I,J)  .GT.  P.GV)  PGV  = V (I  ,J) 

CONTINUE 

SAVFGV  (L 15)  = PGV 

IF  (KTYPEO.EQ. 1)GO  TO  167 

WHITE  (7,  117)  N RU  N (1)  ,NPULSE(1)  ,PEPET(1) 

WFITE  (7,  118)XDPULS,WAVFL,RIM 
WFITE  <7, 119) III, 112,113, JJ1,JJ2 
WPITE  (7,  119)  N 3 , M 3 
W F I T F (7, 120)  (F  (J)  , J = 1 , N 3) 

WFITE  (7,120)  (Z  (I)  ,1  = 1 , M3) 

WRITE  (7, 118) TIMEX (LI  5) 

WFITE  (6,  141)TIMEX  (L15) 

WPITE  (6,63)  ( P (J)  ,J  = JJ1,JJ2) 

JCNT=JJ2-JJ 1+ 1 
IF  (JCNT. GT. 9) GO  TO  400 
GO  TO  401 
JJCNT=JCNT-9 
J JJ2= JJ2-J JCNT 
J JJ2P 1 =J J J 2*  1 
DO  163  1=111,112 
X1=Z  (I) -Z  (IFF) 4DZ/2. 

IF  (JCNT. GT. 9) GO  TC  402 

WHITE  (6,64) XI,  (V  ( I , J ) ,J  = JJ1 , JJ2) 

GO  TO  403 

WHITE  <6, 64) XI  , (V  (I  ,J)  ,J=JJ1 ,JJJ2) 

WPITE  (6,64) X1 , (V  (1 , 0 ) , J=JJJ2P1 , JJ2) 

IF  (KTYPEO.EQ.  1)  GO  TO  1b8 
WHITE  (7, 1 37)  (V  (I ,J)  ,J=JJ1,JJ2) 

CONTINUE 

CONTINUE 

BGV=0. 

DO  405  LL 1 5 = 1 , KT  YPE 

IF  (SAVPGV  (LL 1 5) . GT. FGV) RGV  = SAVRGV (LL15) 

CONTINUE 
WHITE  (7,  396) 

DO  4C6  LL  1 5 = 1 , KTYFE 
WHITE  (7, 137) FGV 

INTFP  POLATE  AXIAL  EXTENT  OF  DAMAGE 

15  = 0 

16  = 0 

IF  ( ID  1 . :g.:D2)GC  TO  182 
DO  175  I=ID1 ,ID2 
L1  = IDUID2-I 

IF  (QD  (LI , 1)  .GT. FOX) I5  = L1 
IF (QD  (LI,  1)  . LT.  FOX) 16  = Li 
IF  (QD  (I,  1)  .GT.  TOX) 17  = 1 
IF (UP  (I,  1 ) . LT. POX) 18  = 1 
CONTINUE 

IF  (IPHT  (9)  . EQ. 0) GO  TO  1h2 
WPITE  (6,350) 

FOFMAT  (1H0,22liAXIAL  EXTENT  OP  DAMAGE) 

IF  (I5.FO.O)  WFITE (6,176) 

FOPMA r (1 HC , 5X,45HDEPTHS  OF  DAMAGE  BEYOND  BOTH  SPECIl l ED  DEPTHS) 
IP  (15 . SO- 0) GO  TO  182 
IF (16 . EQ. C) GO  TO  190 
IF (15. GE. 16) GO  TO  178 

X2  = ALOG  (QD  (lo, 1)/CP (15,1) )/(Z (16) -Z (15) ) 


75 


X1=QD(I5,1)  F E 1 00799 

X3  = ALOG  (P0X/X1)/X2  + Z (15) -Z (I PE) +DZ/2.  F El  00800 

WHITE  (6, 177) X3  FE100801 

1 FOPMAT  (1H0,5X,24HFINIMUM  DEPTH  OF  DAM  AGE=  , E 1 0 . 3 , 2 HCM)  FE100802 

) IF  (18. GE. 17) GO  TC  182  FF100803 

X2=ALOG  (CD (18,1) /QD(I7,1) ) / ( Z (18) -Z (17  ) ) PEI  00809 

X1=QD(I7,1)  FE100805 

X 3= A LOG  (POX/X1) /X2*Z  (17) -Z  (I  PE) «-DZ/2.  FE 10080b 

1 WHITE  (6, 181)  X3  E E 1 00807 

t FORMAT  (1  HO, 5X,24HMAXIMUH  DEPTH  OF  D AMAGE= , E 10 . 3 , 2 HCM ) FE100808 

> INTER  POLAT17  PADIAL  EXTENT  OF  IRPEVEFSIBLE  DAMAGE  AT  SPECIFIED  BF100809 

» DEPTHS  PE  1 OOP  1 0 

! IF  (IPPT(IO)  .E0.0) GO  TO  192  PF10081  1 

WRITE  (6,3b0)  RE100812 

3 FOPMAT  (1  HO, 23HPADIAL  EXTENT  OF  DAMAGE)  RE100813 

DO  189  I=ID1,ID2  PE100819 

J1=0  PE100815 

X3  = Z (I) -Z  (IPE) *DZ/2.  FE100816 

DO  183  J = 1 , J M PE100817 

IF (POX.GT.QD ( I , J ) ) J1=J  PEI  0081 8 

3 CONTINUE  FF 1008 IP 

X20=0.  FE10082C 

IF  (J 1 . 5Q. 0) GO  TO  187  PE100821 

IF  (J1 . EO.JM) KFITE  (6 , 1 8 5) X3 , E (JM)  FF 100822 

3 FORMAT  ( 1 HD, 5X,2HZ  = ,E9. 3,2HCM,5X, 3b H RADIAL  EXTENT  OF  DAMAGE  GF E ATEF RE  1 0 08 2 3 
1 THAN.71C.J, 2 HCM)  FE10082U 

IF  (J1 . EO.JM) GO  "0  189  EF100825 

X 2 = ALOG  (QD  ( I , J 1 ♦ 1 ) /OP  (I,J1)  )/(R(J1+1)-F  (J  1 ) ) SE 1008  26 

X 1 = QD  (I , J 1 ) FE100827 

X 20  = A LOG (POX/X1) /X2+P (J1)  PE  100828 

1 WFITE(6,188) X3,X20  PE10C829 

j FOPMAT(1HO,5X,2HZ=,E9.3,2HCM,5X,37HFADIAL  EXTENT  OF  IPREVEPSIBLF  DPE10083C 
1AMAGt=,E10.3,2HCM)  RE100831 

3 CONTINUE  PF100832 

IF  (LPX . EQ. 0) GO  TO  300  RE100833 

GO  TO  145  F El  00839 

3 WRITE  (6, 191)  PEI  0083  5 

I FORMAT  (1H0,5X,31HNC  DAMAGE LASER  POWER  TOO  LOW)  FF100836 

. IF (LPX.EQ.O)GO  "0  300  RE100837 

GO  TO  145  FE100838 

3 STOP  RE  1 00839 

END  RE100840 

SUBROUTINE  GRID  PE100841 

' GRID  COMPUTES  THE  COEFFICIENTS  IN  PARTIAL  DIFFERENTIAL  EQUATIONS  AFF100842 

• RADIAL  AND  AXIAL  COORDINATES,  P AND  Z,  AND  ASSIGNS  CONDUCTIVITY  ANPF100843 

' VOLUMETRIC  SPECIFIC  HEAT  TO  GPID  RE100844 

► CALCULATE  B(CN**-2)  AND  F (CM)  RE100845 

COMMON  A (29,3)  , AP  , A A V , ACH , A PE , ASC , ATS , A VL , B ( 1 4 , 3)  , EB , BV  ( 1 4 , 3 ) , FEl  00846 

1CONX  (6)  ,CON  (29)  ,CUT,DFLOW  (b)  ,DPULSE,DR,D?,DTX,DZ,FL,HF (14)  , FF1C08U7 

2IAB  (29,14)  ,IBLOOD  (10)  , I FI L , I G , XGX , IHT, I PA , I PC , IPE , I PROF , I PS , I PT , FEl 00848 
3IPV,IV  (2  9) ,JVL,LIP,LPA,LPC,LPE,LPS,LPV, LPX , LT M A X , K , KM , KT,  M,M1 ,M2,  FEl 00849 
4M3,N,N1,N3,N4,NVL,POX,Pn(14) ,PTIME,QP,R (14) , SCO, PIM , PN , PPE , B PT , PEI  00850 

5RVL,RSC,S  (29,14)  ,S H B , T A V , TCH , TOM , TPE , T V L, TS (2200)  ,TSC,TTS,V  (29,14) FEl 00851 
6, VC  (29,14,  120) ,VSH  (29) , VSHX  (6) , W A V EL , XC , XFLOW , X FLOWI (6)  ,XFLOWO(8)  , RE  10  0852 
7 XPD  ( 1 20)  , XT  ( 1 20)  ,ZU«)  ,ZD(8)  , ZM  , FLOW  I ( 1 4)  , FLO WX  ( 1 4)  , FUP TL , SIG M A , PE  100853 
8IPPT  (1C)  , APE1  ,APE2,?.TNT,ZO,FLO,CABEP,CABFF2,PP,PC,NB,NC,FC  PEI  00854 

DIMENSION  I X (7 ) , LX (7)  PE100P55 
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184 

220 

C *** 


18b 

C ♦ ** 


184 

C * «» 


CALCULATE  B (CM**-2)  AND  R (CM) 

WRITE  (6,170) 

FORMAT  ( 1 H 1 ) 

R (1)  =0. 

CK=N-N1 

CP=RVL/DR-N  1 + 1 . 

X 1 = 2 • 

P2=EXP  (A  LOG  (2.*  (CP*  (X 1 - 1 . ) +1 . )/ ( X 1 ♦ 1 . ) ) /(CK-1.) ) 

IF (R2/X1 .GT. . 99999. AND.R2/X1 . LT. 1.00C01) GO  TO  181 

X 1 =R2 

GO  TO  180 

IF  (IPRT  (1)  . Iiy.0)  GO  TO  220 
WRITE  (6,182) 

FORMAT  (1H0,16HGRIC  INFORMATION) 

WRITE  (6, 184) F2 

FORMAT  (1H0,5X,3HR2=,F8. 4) 

B N = DF  * (N 1 - 1 . ♦ (F2** (CK  + 1 . ) - 1 . ) / (R2- 1 . ) ) 

CALCULATE  RADIAL  SPACE  STEPS  R (J) 

DO  18b  J=2,N4 
F (J) =DR*  (J-1) 

X I = P 2*  DR 

DO  186  J =N 4 , N 
R (J  + 1) =R  (J) +X1 
X 1 = P2*  X 1 

CALCULATE  COEFFICIENTS  B OF  FINITE  DIFFEEFNCE  EONS. 
Xl  = 2. / (DP*DF) 

DO  187  J=2,N1 

B(J,1)=.25*  (2*J-3) *X 1/  ( J- 1 ) 

D (J,2) =X1 
B (J, 3) =X1-B  (J, 1) 

X2  = DR 

X 1 =R  2 *DF 

DO  188  >1  = N 4 , N 
E (J  , 2)  =2./(X  1*X2) 

B (J, 1)= (2./X2-1./F  (J) ) / (X 1 + X2) 

B (J,  3)  =B  ( J , 2 ) -B  (J,1) 

X2  = R2*  X2 
X1=R2*X1 
B (1,1) =0. 

B(1,2)=2./(DR*DR) 

E ( 1 , 3)  =B ( 1 , 2) 

DO  189  J = 1,N 

IF  (R (J)  . LT. 3VL) JVL  = J 

CONTINUE 

CALCULATE  AXIAL  SPACE  STEPS  Z (I) 

CK=M2-M1+1 

X I = 2 . 

CP=2.*TAV/DZ*1.-  (X1**(CK-1.)-1.)/(X1-1.) 

R1  = EXP  (A LOG  (CP*X 1-CP  + 1 . ) /CK) 

IF (R1/X1.GT. .99999. AND. P1/X1.LT. 1.00001)GO  TO  192 
X 1 = P 1 

GO  TO  140 

ZM=  ( (R1**CK”1.)/(E1-1.) ♦M1-1.)*DZ 
IF  (IPRT  ( 1) . EC.C) GO  TO  230 
WRIT’1'  (6,184)  P 1 , ZM 

FORMAT  (1H  ,5X,3HR1  = ,F8.4,2X,3HZM=,F8.4) 

X 1 = D7. 


R E 100856 
R E 1 00857 
RE100858 
RF100859 
RE100860 
R El  00861 
R El  00862 
PEI  00863 
PFl 00864 
R El  00865 
PEI  00866 
PEI  00867 
P FI  00868 
P F 1 00869 
PFl 00870 
P E 1 00871 
PE100872 
PE  1 0087  3 
EF100874 
RE1C0875 
F FI  00876 
PEI  00877 
PEI  00878 
FE1 00879 
RE1 00880 
RE100881 
RE100882 
FE1C0893 
PEI  00884 
F E 1 00  88  5 
PEI  0088b 
RF100887 
RSI 008RU 
EE1008R9 
F El  00890 
PE100891 
PF100892 
PEI  0089  3 
R E 1 0089  4 
PE100895 
PF1C0896 
RE100897 
F El 0 0898 
P^l 00899 
PEI  00900 
FE1 00901 
EE10C902 
RE100903 
PEI  00904 
PEI  00905 
PEI  00906 
RE100907 
PEI  00908 
P F 1 00909 
RE10091C 
RF10091 1 
RE100912 
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r 


l 


k 

' > ij 


X2  = X 1 

P F 1 0091  3 

PO  195  1=2, M2 

FE100914 

Z (M2*I) = Z M ♦ X 2 

E E 1 009 1 5 

Z (M2+2-I)  =ZK-X2 

R F 1 009 1 6 

IF  (I.GT.M 1)  X 1 = F 1*X1 

RF1C0917 

195 

X2=X2+X1 

FE100918 

7.  (1)  =0. 

FE100919 

Z (M2* 1 ) =ZM 

P El  00920 

Z (M*1  ) = 2 • *ZM 

P FI  00921 

X 1 = 7.  ( X P il ) -DZ/2. -ZD  (2) 

RE100922 

DO  146  1*1, M3 

RE1C0923 

1 96 

Z(I)=Z(I)-X1 

FF100924 

L3=IPA 

F F 1 0092  5 

DO  2C0  L= 1 , 7 

PEI  00926 

11=0 

F E 1 00927 

DO  197  I=IPA,M3 

FF1C0928 

IF  (Z  (I)  . LT. ZD  (1*1) ) L 3 = 1 

PEI  00929 

IF  (Z  (I)  . LT.  ZD  (L)  .On. Z (I) 

.GE. ZD (L+ 1) ) GO  t0  197 

K El  00930 

L2=  I 

PE100931 

LI  = LI + 1 

PEI  00932 

1 97 

CONTINUE 

EE100933 

IF (Li . EQ. 0) IX (L) =L3 

RE100934 

IF (LI . EQ. 0) LX (L) =L3 

R E 1 00935 

IF  (LI  .O'".  0)  IX  (L)  =L2+  1-L1 

RE100936 

IF  (LI  .GT. 0) LX (L)  =L2 

PEI  00937 

200 

CONTINUE 

PEI  00938 

IPV  = I X (4) 

PE100939 

IPC=I X (5) 

PE100940 

IPS  = 1X  (6) 

R El  0094 1 

IPT  = T X (7) 

F^100942 

LP  A = L X (1) 

PF100943 

LPE  = L X (3) 

PF100944 

LPV  = LX  (4) 

RF100945 

LPC=LX  (5) 

BE100946 

LPS=LX (6) 

F E 1 00  947 

LPT  = M 3 

BE100948 

C *«* 

SET  CONDUCTIVITY  CON  AND 

HEAT  CAPACITY  VSH  FOP  VAPIOUS  EYE  MEDIA 

F E 1 0094  9 

DO  203  1*1, LFA 

PEI  00950 

CON  (1) =CON  X (1) 

P E 1 00  95 1 

203 

VSH  (I)  = V S H X (1) 

R E 1 00°52 

DO  204  I=IPE , LPE 

H F 1 00953 

CON (I) =CON  X (2) 

PF100954 

204 

VSH  (I) =VSHX  (2) 

EF100955 

DO  205  1= I P V , LP V 

PEI  00956 

CON  (I) =CONX  (3) 

PEI  00957 

205 

VSH (I) = V 3 H X (3) 

FE10095R 

DO  206  1 = 1 PC, LPC 

RE1009S9 

CON (I) =CONX  (4) 

PF  1 00  960 

2 06 

VSH (I) = VS  H X (4) 

RF1C0961 

DO  207  I=IPS,LPS 

P F 1 009  62 

CON  (I) =CONX (5) 

FE100963 

207 

VSH  (I) =VSHX (5) 

F FI  00964 

DO  208  1 = 1 PT , M 3 

RE100965 

CON  (I) =CON  X (6) 

P FI  00966 

2 06 

VSH  (I ) = VSH  X (6) 

B El  00967 

C *** 

CALCULATE  COEFFICIENTS  A 

OF  FINITE  DTFFEFENC?  EONS. 

?r1 00969 

DO  210  1 = 1 PA , “ 

S1 100969 

78 


I 


X 1 = Z (I+1)-Z  (1-1)  PF100979 

X2=  (CON  (1-1) -CON  (1  + 1) ) /(XI* XI)  P PI  0097 1 

X3  = 2.*CON  (I) /XI  R E 1 00972 

A (I, 1) =X2*X3/  (Z  (I) -Z  (1-1)  | PEI 0097 3 

IF  (I.EQ. IPA) A (I, 1) =0.  PEI  00  974 

A (I, 3) =-X2*X3/  (Z  (1*1) -Z  (I) ) PEI  00975 

210  A (1,2) =A  (I,  1) *A  (1,3)  PF100976 

PETURN  PEI  00977 

END  RF1C0978 

SUBROUTINE  IMAGE  PE100979 

C ***  IMAGE  COMPUTES  THE  RETINAL  IRRADIANCF  PROFILE  PE100980 

COMMON  A (29,3)  , A P , A A V , ACH , A PE , ASC , ATS, AVL, B (14,3),i»B,BV(14,3),  RE100981 

1 CON  X (6)  , CON  (2  9)  ,C0T , UFLOW  (6  ) , DPIILS  E , DP  , CT  , DT  X , DZ  , FL  , HR  ( 1 4)  , F FI  00982 

2IAB(29,14)  , I BLOOD  (10)  , I FI L, IG , IGX , IHT, I PA , I PC , I PE , IPPOF , IPS , IPT , PE100983 

3 IP V, IV  (29)  , JVL,LIM,LPA , LPC , LPE, LPS , LPV , LTX , LTM AX, K,KM,KT,M, Ml ,M2,  FF100984 
4M3,N,N1,N3,N4,NVL,P0X,PP(14)  , P? I ME , OP , R ( 1 4)  , PCO, BIN , BN , RPE , B RT , RF1 00985 
5PVL,RSC,S  (29,14)  ,SHB,TAV,  TCH  , TOM  , TPt  , T VL , TS  (2200)  ,TSC,TTS,V  (29 , 14)  BE1  00986 
6 , VC  (29,14, 120)  , VS  H (29)  ,VSI!X(b)  , U A V EL  , XC,  X FLO*  , X FLOW  I (6)  ,XFLOWO(6)  ,PE100987 
7XPD  (120)  , XT  (120)  ,Z  (2U)  ,ZD(8)  ,ZM, FLOW I ( 14)  , FLOP  X (14)  .PUPIL, SIGMA,  PF1 00988 
8 1 PET  (10)  , A PEI , APE2,RINT,ZO, FLO, CA BSF , C ADEP 2, PP.PC, NB, NC, FC  FE100989 

DIMENSION  FA  (2001)  ,FP  (2001)  , FX  (2001)  ,FY  (2001)  , JO  (32)  ,NA  (22)  ,PX  (3C)  F,E1  00990 
1,  PX(30),XF1  (2001), XF2  (2001)  BE100981 

PEAL  JO, NA,NB,NC  PE1C0992 

DO  200  J = 1 , N P E 1 0099  3 

200  PP  (J) =0.  KE10C994 

LI=500  PE100995 

LII^LI  R El  00996 

DO  201  L= 1 , LI  PE100997 

201  ^X  (L) =0.  RF100°98 

RFAD(5, 202) PUPIL  RE1009QQ 

202  FORMAT  (10E8. 3)  RE101000 

EINT=PUPIL/  (LI-1)  PEI  0 1 00 1 

IF  (IPPOF. £Q. 1) GO  TO  214  RE101002 

IF  (IPROF.EQ.O) GO  TO  219  PE101003 

C ***  I NTEI POL ATE  IRREGULAR  LASER  PRO  FI L£ (S YM MET  PIC  IN  F)  AT  INTERVALS  PE101004 
C ***  OF  PINT  STARTING  AT  F=0  RF1010C5 

READ (5,205) LP  RE101006 

205  FOPM AT  (17)  R F 10 1 007 

READ(5,206)  (FX(L)  ,L=1,LP)  PF101008 

206  FORMAT  (10E7. 3)  RF101009 

READ  (5,206)  (PX(L)  ,L=1,LF)  PE101010 

XI  = PX  (1)  RE10101 1 

DO  207  L= 1 , L3  PE101012 

207  PX  (L) =PX  (L) /XI  PF101013 

X5=0 . PF101014 

X6=0 . FEIOIOI^ 

DO  208  L=2,LR  RF101016 

X2= (PX  (L) -FX  (L-1) ) / (P  X (L) - R X ( L— 1 ) ) RE101017 

Xl  = PX  (L-1) -X2*PX  (L-1)  PE101C18 

X3  = Xl*(RX(L)*BX(L)-PX(L-1)*PX(L-1))/2.  RF101019 

X4=X2*  (RX  (L) *RX  (L)*RX(L) -RX (L-1)*RX (L-1) *FX (L-1)  ) /3.  RE10102O 

IF  (RX  (L) ,GT. PUPIL) X6=X6* 6. 2832* (X3+X4)  RF101021 

208  X 5 = X 5 + 6 . 28 32*  (X3  + X4)  RF101022 

QP=POX*. 23906*  ( 1 . -RCO) /X 5 RE101023 

XX=  (X5-X6) /X5  RE101024 

IF (RX  (LR) .LT. PUPIL) LI I*BX (LP) /BINT* 1 RF101025 

L2  = 2 RE  1 0 1 026 
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210 


.12 


213 

C **• 

214 


216 

217 


218 

C * * * 

219 


220 


221 


222 

C *** 

c *** 

223 


224 

c *** 


X1=0. 

DO  213  L= 1 , LII 

IF  (PX  (L2)  .ST. XI) GO  TO  212 

L2=L2+  1 

IF (L2.LE. LB) GO  TO  210 
GO  TO  213 

X2=  (X  1-RX  (L2-1) ) / (EX (L2) -8X (L2-1)  ) 
FX  (L)  =PX  (L2-1)  ♦ X2*  (P  X ( L2) -PX (L2-1)  ) 
X 1 = X 1 ♦BINT 

GO  TO  223 


F El  0 1 027 
F E101028 
EF1C1029 
EE101030 
P.E1010  31 
F El  0 1 032 
PE101033 
PEI  01 034 
RE101035 
R El  0 1 0 36 


CALCULATE  GAUSSIAN  LASEF  PROFILE  AT  INTFEVALS  OF  PINT  STARTING  AT 
SIGN  A = E I M*  5QPT  (-2. /A LOG  (CUT)  ) 

^P=2.« POX*. 2390b*  (1.-RCO) /<3.l4lL*STGMA*?IGMA) 

XX  = 1. -EXP (-2. “PUPIL* PUPIL/ (SIGMA* SIGH A) ) 

:f(if:l. ec. i>go  to  217 

DO  216  J=  1 , N 

X3  = 2. *S (J) *B  (J)  / (SIGMA* SIGMA) 

IF (X3.GT.80.) GO  TO  216 
PR  (J)  = EX  P ( — X 3 ) 

CONTINUE 
GO  TO  276 
X1  = 0. 

DO  218  L= 1 , LII 
X3=2.*X1*X1/  (SIGN A* SIGMA) 

FX (L) =0. 

IF (X3.GT.80.) GO  TO  218 
FX  (L)  = EXP  (-X3) 


PE101037 
PEI  01 0 38 
PEI  01 039 
RE  101040 
FE101041 
FE101042 
PE101043 
RE101044 
PF101045 
E E 1 0 1 0 46 
R E 1 0 1 0 4 7 
PE101048 
KEl 01 04° 
RF101050 
RE101051 
RF101052 
P.E101053 


Xl=Xl +EINT 
GO  TO  227 

SPECIF?  UNIFORM  LASEF  PROFILE  PROM  F(1)  TO  F (LIU) 

QP  = POX * . 2 3906*  (1  .-PCO) / ( 3 . 141 6* RIM* RIM) 

XX=1 . 

IF  (RIM. GT. PUPIL) XX=PUPIL* PUPIL/ (PIN* RIM) 

IF (IFIL.EO* 1)«0  TO  221 
DO  220  J = 1 , LIM 
PP  (J)  =1 . 

GO  TO  276 
L 1 = P IM/P I N T 
E I NT=  RIM/L 1 
LII  = RIM/FINT«-1 
DO  222  L= 1 , LII 
FX (L) =1 . 

GO  TO  227 

CALCULATE  TOTAL  APIA  FA  (L)  AND  PORTION  OF  IASEPS  POWEP 

AND  ( L - . 5 ) *PINT 

IF  (IFIL.EQ. 1) GO  TO  227 

FP  (1) =3. 1416*FX  (1) *EINT*FINT/4. 

FA  (1) =3. 1416*PINT*RI NT/4 . 

DO  224  L=2 , LI I 
X1=  (L-.5) ♦ HINT 
X2=  (L- 1 . 5)  * RI  NT 

FP  (L) =FP  (L-1) *FX  (L) *3. 1416* (X  1*X 1-X2*X2) 
FA(L)=FA(L-1)*3.1416*(X1*X1-X2*X2) 

CALCULATE  PROPILE  PF(J) 

X1  = 0. 

X2=0. 

DO  225  J=1,N 


PEI  01 054 
BE101065 
RE101056 
RE  1 0 1 0 57 
R El  0 1 0 58 
R E 1 0 1 0 59 
RE101060 
RE101061 
R El  01062 
R El  0 1 063 
RE101064 
FE101065 
PEI  0 1 066 
PE101067 
FE101068 
E E 1 0 1 069 
BETWEEN  F=0EF101O70 
RE101071 
FE101072 
EE101073 
RE1 01074 
PEI  01 075 
RE101076 
P El  0 1 077 
F El  0 1 07  8 
PE101079 
PE10108C 
FF101081 
PE101082 
P E 1 0 1 083 
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X 3 = ( ' (J)*F(J+1))/(2. *61  NT) ♦ . 5000001 
IF  (X  3. LT.  1 . ) X3= 1 .000001 
L2  = X 3 

IF (L2.GE.LII) GO  TO  225 
X4  = X 3-L2 

X5=FP(L2)+XU*(FP(L2*1)-FP(L2)) 

Xfc  = FA  (L2) ♦ X4*  (FA (L2* 1) -FA  (L2) ) 

PF (J)  = ( X 5- X 1 ) / (X6-X2) 

X 1 = X 5 
X2  = Xb 

225  CONTINUE 
GO  TO  27b 

C ***  SPREAD  FUNCTION  CALCULATIONS 

227  READ (5, 202) ZO,FLO, FC, NB, CABER, PP, PC 
CABEF2=CABER/W AVEL 
PEAD(5,228)  (JO  (L)  ,L=1,32) 

22b  FORMAT  ( 1 0 F8 . 5) 

RFAD (5, 22 8)  (N A ( L) , L= 1 , 22) 

X1= (WAVEL-350.) /50. ♦ 1 . 

L1-X1 
X2=  X 1 - L 1 

NC=NA  (Li) *X2*  (NA  (L1  + 1) -NA  (LI) ) 

XI = (NB-1 . ) *NC/ (NB*  (NC- 1. ) ) 

FL=  FLO*  X 1 
X 2 = 2 0/ FLO 

XC  = N'C*ZO*X  1/  (NC*X2-X  1 ) - FLO 
X3= 1 . -PC*  (NC* ZO-f C) / (NC*ZO*FC) 

DO  230  L= 1 , LI 
IF (L.GT.LII) GO  TO  230 
X1= (L- 1) /X3*1 .000001 
L 1 = X 1 
X2=X 1-Ll 

IF (LI  + 1 . GT. LI) Fi  (L) =0. 

IF (L1+ 1. GT. LI) LI I=L 
IF  (L1  + 1. GT.LI)GO  TO  230 

FX  (L)  = (FX  (LI) +X2*  (FX  (Ll  + 1) -FX  (LI) ) ) /(X3*X3) 

230  CONTINUE 

DO  231  L= 1 , LII 

231  F X (L) =FY  ( L) 

X 5 = AT  AN (PUPIL/  (FLO-PP*XO) ) 

X6  = 1 . -COS  ( X 5) 

X7  = S IN (X5) * SI N ( X5) 

FF=FLO-PP 
DO  234  L= 1 , LII 
X 4= (L- 1) ‘PINT 

X1=6.2832*NC*(-FF-Xb*X0+SQRT(FF*FF-X7*X0*X0))*X4»X4/(WAV-.L*1.E-7* 

1PUPIL*PUPIL) 

X2=CA3£P2*X4»X4'X4*X4 

XF1 (L) =SC3T  (FX  (L) ) *COS (XI* X2) 

234  XF2  (L)  =3 OPT  (FX  (L) )*SIN  (XI* X 2) 

DO  260  J = 1 , N 

X1=6.28  32»P  (J)/(WAVEL*1.E-7«FF) 

X2  = 0 . 

X3  = 0. 

DO  255  L= 1 , LI  I 
X 4 = X 1 * (L-1) *PINT 
IF  (L.EQ. 1) X4  = X1“.25*RINT 


PE101084 
PF101085 
RE1C1086 
RE101087 
PF101 088 
PE101089 
RF101090 
RE101091 
R El  0 1 09  2 
PE1C1093 
RE101094 
RE101095 
RE1 01 096 
FE101C97 
R E 1 0 1 093 
PF101 099 
RE101 100 
RE101  101 
RE101  102 
RF101 103 
P E 1 0 1 1 04 
PEI  0 1 1 C 5 
PE101 106 
RE101107 
P EI  01 1 08 
RE101 109 
RE101  1 10 
PE101111 
FE101  112 
P E 1 C 1 1 1 3 
RE101  1 14 
RE101115 
PE101116 
PEI  01 1 17 
PEI  01 1 18 
RE1C11 19 
RE101 120 
R F 1 0 1 1 2 1 
PEI  01 122 
RF101 123 
FF1 01  124 
P E 1 0 1 1 2 5 
PE101126 
FE101127 
FE101128 
F.E1  01 129 
PE101 130 
FE101131 
FF101  132 
PE101 133 
F.E101  134 
RF101 135 
PF101136 
PEI C 1 137 
KE101 138 
RE101 1 39 
FE101 140 


IF  (X4.GI.  3. ) (JO  1C  25C  EE1C1141 

X 5 = X4 / . 1 +1 .000001  PE101142 

L 1 = X 5 PE101143 

X5=X5-L1  F FI  01 1 44 

X7=JO  (LI ) *X5*  (JO  (L1*1) -JO  (Li) ) FIlOlluS 

GC  TO  251  FE101146 

2 SC  X6  = 3./X4  F E 1 0 1 1 47 

X8  = . 7 97  38456-.  P0PC0077*X6- . 005527  4 0*  X6* X6- . 000CS5 1 2*  Xfc*X6*X6*  PEI  01 148 

1 .OC  1 372  ;7*  Xb»X6*X6* X 6 -.00072805* X6*X6»  Xfc*  X6*X6+.00C  14476* X6*X6*X6*P  El  01 149 
2X6*Xt*X6  RE101150 

X9  = Xu-. 7 853981b- .041 66397* Xb-. 00003 954*  X6*Xb* .00262573* Xb*X6*X6-  FF101 151 

1 .00054 125* Xo*X6*X6*X6- . 00029333* Xb*X6*Xt*X6*Xb*. 0001 3558*X6*Xb*X6*FF101 152 
2X6*Xb*X6 

X 7 = X ;'  * C 0 8 ( X 9)  /SOFT  ( X4) 

251  IF  ( L . G T . 1)  GC  TO  152 

X2=X2*X7*,25*  ( 3 . * XF 1 ( 1 ) ♦ XF 1 (2))*.25*PIN1*.5*FINT 


:5*(3.*XF2(1)*XP2U))*.25*FINT*.5»:iNT 


c52 

2Z5 

2 ij  ( 


270 

271 

272 


2 76 

280 


X3=X3*X7" 

GO  TO  2^ c 

X2  = X2*X7*X?1  (L)*  (L-1)  * PINT*RINT 
X3=X3+X7*  XF2  (L) * (L-1) * FIN?* PINT 
CONTI  Nu- 
ll F (.1)  = X2*X2  + X3*X3 
X 1 = HF  (1) 

DO  27  0 0=1,  N 
HE  (.1)  = H"  (J)  /XI 
X 1 =. 0002 

X2=3.1416«X1*X1/4 
0 = 2 

X4=HP  ( 1)  * X2 
L 1 =2 

IF ( X 1 .LT.P (J) *.0000001) GO  TO  272 
J=J  + 1 
GO  TO  271 

X5=  ( X 1 - R (J-1)  )/  (P  (J)  -F  (J-1)  ) 

X 6 = H P (J-1)  ♦ X 5 * (HP (J)  -HF  (J-1) ) 

X7  = 8. * (LI- 1)  *X2 
X4=X4+Xn*X7 
L 1 = L 1 + 1 
X1=X1+.0C02 
IF (XI .LE. . 1) GO  10  271 
QP=. 2390 6* XX* POX*  (1.-RC0)  /X4 
SETUP  N 

DO  280  J = 1 , N 
HF  (J)  =PF  (J) 

RETURN 
END 

SUBPOUT IN E HTXDFP 

HTXDFP  CON.  PUT  ES  K A""  E OF  HEAT  DEPOSITON  AT  VARIOUS  POINTS  I,J 
COHNON  A (29, 3)  , A P, A A V , ACH, APE, ASC , ATS , A VL , B (1 4 , 3)  ,6B,BV(14,3)  , 

1CONX (6)  , CON (29)  ,CUT, DFLOW (6)  , DPU LS E , DP , DT , DTX , DZ , FL , HR ( 1 4)  , 

21 AB  (2  9,1 4)  , IULOOD  (1C)  , I FI L , IG , IGX , XHT , T PA , I PC , I PF , I PROF , I PS , IPT , 

3 IP V, IV  (2  9)  ,JVL,LIN,LPA  , I.PC , LPE , LPS , LPV  , LPX  , LTFI  AX  , K , K« , KT,  K,M1,H2, 

4H3,N,  N1 , N3,  N4  ,NVL,POX,PR  (14)  ,PTI«E,0P,B  (14)  ,RCO,  FIB,PN,  KPE,PRT, 

5PVL,FSC,S  (29,14)  ,S!!B,TAV,TCH  , TOM  , T PF  ,T  V L , TS  ( 220 0)  ,TSC  , TTS  , V (2  9 , 1 4)  PF101194 
4,  VC  (29, 14,  12  0)  , VSH  (2  9)  , VSHX  (8)  , N A V FL,  XC  , XFLOW  ,XFLCWI  (6)  , XFLOWO  (6)  ,FF1 01 I^S 
r*p  (120)  , XT  (120)  ,'i  (29)  ,70(8*  , ZN, FLO«I ( 1 4)  , FLOWX ( ’ M , PUPIL,  SIGH  A , FE*  01  196 
• - ' - /**.  ,APr  1 , A PF2  , ’’IN",  ZO,  FLO,  C ABET  ,CABEP2,Pt,  PC,  VF.NC,  '■C  E -*01  197 


EL101 15 j 
FE101154 
PF101 155 
PEI  01 156 
PEI  01  157 
PE10115B 
FE101 159 
FE' 101160 
PEI  01 161 
PF101 162 
P F 1 0 1 1 6 3 
PE101 164 
FF1n1165 
BF101 166 
FF.101167 
PF101168 
PE101 169 
RE101170 
PE  1 01 1 7 1 
FE101 172 
FE101173 
PE101174 
RF101 175 
RF101 176 
PE101  177 
FE101 17rt 
FF101 179 
PF101180 
RF101181 
BE101162 
EE101 183 
KF1C1184 
FE101 185 
RE101186 
R El  0 1 1 87 
EE101188 
BE101  189 
RE1 01 190 
FE101191 
RF101 192 
RE101143 


DIMENSION  AB  (29, 3)  , AbR  (29,7)  ,ABS  (7)  ,11  (29)  ,IZ  (29)  , REF  (8)  , REFL  (8)  , PEI  01 198 
1 Z H (29)  RE101199 

IF  (IHT.EQ.O)  PETIJPN  FE101200 

IF  (QP.LT.  1.E-25)  C.C  TO  340  RF101201 

IF  (IHT.SU.  1)  RETURN  RE101202 

LZ=7  RF101203 

LZ0=LZ-1  PE1012C4 

LZ  1 = LZ  + 1 R E 1 0 1 20  5 

DO  280  1=1, M RE101206 

II (I) =0  F El 0 1 20 7 

IZ(I)=0  RE101208 

ZH (I)  = (Z  (I)  +Z (!♦ 1) ) /2.  RE1C1209 

DO  279  1.1=1 ,3  RE101210 

279  A3  (I , L 1 ) =0.  RE101211 

DO  280  L 1 = 1 , L Z RF101212 

280  ABR  (I, LI) =0.  RE101213 

DO  282  L 1 = 1 , LZ  PF191214 

REF  (L 1 ) =0 . P El  01 21 5 

282  REFL  (LI) =0.  RE101216 

PEF  (2)=RPT  RE101217 

PEF(6)=RSC  RE101218 

PEF  (LZ 1) =0.  PE101219 

IF(IPRT(1) . EQ.O) GO  TO  350  RF101220 

HPITE  (6,283)  (ZH  (I)  ,1  = 1 ,M)  PF101221 

283  FORMAT  (1H0,5X,3HZH=/(1H  , 5 X , 1 OE 1 0 . 3 ) ) RE101222 

C «**  EVALUATE  ABSORPTION  CONSTANTS  APE1  AND  APE 2 FOR  FRONT  AND  REAR  OF  PE101223 

C ***  PE  AS  WELL  AS  IG  INDICATING  I INDEX  WHERE  GRANULES  ARE  LOCATED  RE101224 

350  IF (IGX.EQ. 1 ) GO  TO  284  RF101225 

APE1=  (APE-ACH*  (1.-FPF) ) /PPE  PEI  01 228 

APE2=ACH  RE1C1227 

AP=  (EXP  (-ACH«EPE*TPt) -EXP (- A PE  1 * RPE*TPE) ) / (1.-EXP (-APE1* RPE*TP£) J RF 101228 
IG=I PE  PE101229 

GO  TO  285  PE101230 

284  A p E 1 = A C H PE101231 

APF2=  (APE-ACH* RPE)/(1.-PPE)  PEI  01 232 

AP=  (EXP  (- ACH*  (1  .-tPF.)  *TPE)  - EXP  (-APE2*  (1  .-PPE)  *TPE)  )/  (1.-EXP  (- APE2* BE1 0 1 23 3 

1 (1.-EPE)  *TPE)  ) PF101234 

IG  = LPE-  (1.001 -PPE)*  (LPE-IPE+1) +.5  R El  01 23 5 

285  ABS  (1) = A A V RE101236 

ABS  (2) =AP£1  RE101237 

ABS  (3) =A  PE2  PEI  01 238 

ABS (4) =AVL  RE101230 

ABS  (5 ) = ACH  RF101240 

ASS (6 ) =ASC  RF101241 

ABS  (7) =ATS  RE101242 

L1=2  RE101243 

DO  308  I = I p A , M RF 1 0 1 244 

295  IF  (ZH  (1-1)  .LT.ZD  (LI) ) GO  TO  296  FE101245 

L 1 = L 1 ♦ 1 RF101246 

GO  TO  295  P E 1 0 1 247 

296  IF (ZH  (I) .GE.ZD  (LI) ) GO  TO  299  FF101248 

C ***  NO  ZD  BETWEEN  ZII(I-I)  AND  ZH(I)  PF101249 

AB  (T, 1)=ABS  (L1-1)»  (ZH (I) -ZH (1-1)  ) Rrl01250 

II(I)=1  PF1C1251 

IZ  (I) =L1  F E 1 0 1 252 

IF  (LI  . GT.  L7.)  GO  TO  306  PF101253 

DO  297  L2  = L1  ,L7.  RE1C1254 
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297  ABF  (I , L2) = AB  (1 , 1 ) 

GO  TO  30b 

299  IF  (ZH  (I)  .G2.ZB  (X.1  + 1)  ) GO  TO  333 

C **»  ONLY  Z D (L  1 ) BETWEEN  ZH(I-I)  AND  Z H ( I) 
AB(I,1)=ABS  (1.1-1)*  (ZD  (LI)  -ZH  (1-1)  ) 

AB (I, 2) =A3S  (LI) * (ZH(I)-ZD(LI)) 

Ab?  (I, LI) =AB  (1,1) 

II  (I) =2 
IZ (I) =L1 
L3=L 1 ♦ 1 

IF (L3.GI.LZ) GO  TO  306 
DO  300  L2=L3,LZ 

300  ABF  (I,L2)=AB  (1,1) ♦ A B ( I , 2 ) 

GO  TO  306 

C ***  ZD  (L 1 ) AND  ZD  (L1+1)  BETWEEN  ZH  (1-1)  AND  ZH(I) 
303  AB (I, 1) =ABS  (L 1 - 1 )*  (ZD  (Li) -ZH  (1-1) ) 

AB (I, 2)=ABS  (LI)  * (ZD  (Li + 1) -ZD  (LI) ) 

AB  (I,  3)  = A BS  (L 1 ♦ 1 ) * (Z  K (I)  -ZD(L1*1)  ) 

ABP  (I, LI) =AB  (1,1) 

ABB  (I , LI ♦ 1 ) =AB  (1,1) ♦ AB  (1,2) 

II  (I) =3 
IZ (I) =L1 
L3=L  1 ♦ 2 

IF (L3. GT. LZ) GO  TO  30b 
DO  304  L 2 = L 3 , LZ 

3 04  ABP (I,L2) = AB  (1,1) ♦ A B (I  , 2 ) ♦ A 5 (1,3) 

3 06  CONTINUE' 

DO  314  I=IPA,M 

IF  (AB  (I, 1) .GT. 10. ) AB  (I, 1) =10. 

IF  (AB  (I, 2) .GT. 10. ) AB  (1,2) =10. 

I P ( AB  (1 , 3)  . GT . 1 C . ) AB  (1 , 3)  = 1 C . 

DO  314  L=2,LZ 

IF(ABS(I,L).GT.10.)ABF(I,L)=10. 

314  CONTINUE 

C ***  DEPOSITION  BY  INCOMING  BEAM 
X2  = QP 


PE101255 
BE101256 
BE101257 
EE1 0 1 2 58 
PEI  01 259 
PF101260 
PEI  01 261 
P E 1 0 1 262 
PEI  01 263 
FF101264 
PE101265 
B E 1 0 1 266 
P El  0 1 267 
BE101268 
RE101269 
R El  01 270 
PEI  01 27 1 
PEI  0 1 272 
RE101273 
RE  1 01 274 
RF101275 
R E 1 0 1 27  6 
RE  1 0 1 277 
RE101278 
R F 1 0 1 279 
RE101280 
PE1012ei 
RE101282 
PEI  01 283 
RE101284 
RF101285 
RE101286 
P El  0 1 2 87 
RE101286 
P El  0 1 289 
PF101290 


L 1 = 2 

DO  317  I = IP  A , (1 
L 2=  1 1 (I) 

X 3=  X 2 

X2  = X2*EXP  (-Ab  (1,1)) 

X4  = 0. 

IF (L2. Eg. 1) GO  TO  315 
L3  = I Z (I) 

X4  = X2*R?F  (L3) 

X2  = X2*  (1.-REF  (L3) ) *FXP (-AB (1,2)  ) 

IF(L2.EC. 2) GO  TO  315 
X4=X4*X2*FFF  ( L 3 ♦ 1 ) 

X 2 = X 2 * (1.-PEF ( L 3 ♦ 1 ) ) *FXP(-AB(I,3)  ) 

315  IF(X2. LI. 1.F-10)  X2=0. 

DO  317  J=1,JVL 

S (I,J)  = (X3-X2-X4) *HP  (0) / (ZH (I) -ZH (1-1)  ) 

IF  (S  (I, J) .LT. 1 . ~-1 0/DPULSE) S (I, J)  =0. 

317  CONTINU" 

C ***  CALCULATION  Of  PEFLSCTED  INTENSITIES  BY  VARIOUS  INTEFFACES 
C ***  STARTING  WITH  FTPST  INTERNAL  INTERFACE 
X2  = QP 


EE  1 0 1 29 1 
PE101292 
P El  01 2°3 
RF101294 
PEI  01 295 
PEI  01 296 
RE101297 
PEI  01 298 
PE101299 
PEI  01 300 
P E 1 0 1 30 1 
RE  1 0 1 302 
RE101 303 
RE  1 0 1 304 
RE101305 
BE101 306 
PF1 01 307 
RE1 01 308 
BF.  101309 
PE101310 
PE101311 


T I 


32; 


324 


325 


326 

327 


C *** 

34C 


342 


(_•  * ** 

C * ** 


403 

405 

407 


DO  322  L 1 = 1 , LZO  RF101312 

X3=ABS (L1>* (ZD (L 1 ♦ 1 ) -ZD (LI)  ) PE101313 

IF  (X3.GI. 10.) X3  = 10.  RE101314 

X2  = X 2*  EXP  (-  X 3)  PEI  01 31 5 

FEFL  (Li* 1 ) = X2*  R E F ( L 1 ♦ 1 ) RE101316 

X2  = X 2*  (1.-PEF (L 1 ♦ 1)  ) RF101317 

ro  327  L 1 =2 , LZ  BE101318 

1 = 1 PA  EE  1 0 1 31 9 

IF (ZH (I)  .GT.ZD  (LI) ) GC  TO  325  RE101320 

1=1+1  RE101321 

IP'  (I . LE.  *1)  GO  TO  324  EF101322 

00  TO  327  P E 1 0 1 323 

X2=REFL(L1)  EE101324 

DO  326  L 3 = IPA , I R FI  0 1 325 

X3=X2  SF101326 

L4=I+IPA-L  3 RE101327 

X2  = X2*EXP (-ABP  (L4,L1) ) RE101328 

DO  326  J= 1 , JVL  PF101329 

S (L4, J) =S (L4 , J)  + ( X 3 - X 2 ) *KP  (J) / (ZH  (L4) -ZH  (L4- 1) ) F El  Cl  330 

IP (S (L4, J) .LT. 1 . E- 1 C/DPULS E) S (L4, J) =0.  PE  101 331 

CONTINUE  PE101332 

CONTINUE  PE101333 

IHT= 1 EE101334 

RETURN  PE101335 

NO  HEAT  DEPOSITION, BEAM  OFF  FE101336 

DO  342  1=1, M3  FE101337 

DO  342  J = 1 , N 3 F FI  01  338 

S(I,.T)=0.  FE101339 

IHT  = 0 PEI  01 340 

RETURN  FE101341 

END  PE101342 

SUBROUTINE  MXGPAN  PE101343 

THIS  POUTINE  COMPUTES  CONSEQUENCE  OF  GEANULAF  ABSORPTION  ON  FE101344 

TFMPEF ATUKE  VARIATIONS  IN  PE.  (USED  ONLY  ONCE.)  FF101345 

COMMON  A (29, 3), AP, AAV, ACH , APE , ASC , ATS , A VL , B (14,3),BB,BV(14,3),  PE101346 

1CONX (6)  , CON  (29)  ,CUT,  DFLOK (6)  , DPULSE , DR , DT , DTX , DZ , FL , HF  ( 1 4)  , F FI  01 347 

2IAB(29,14)  , IBLOOD  (1C ) , I FIL , IG ,IGX , IHT, I PA, I PC , I PE , I PROF , IPS , IPT , FE101 348 

3 IP V, IV (29)  ,JVL,LIM,LPA , LPC , LPE , LPS , LPV , LPX.LTMAX,  K, KM,K7,  M,  Ml  , M2,  PF101 349 

4 M 3 , H , N 1 , N 3 , N 4 , N V L , PO  X , P R (14)  , PT IME,QP,F  (14)  rKCO,PIM,PN,RPE,PRT,  RE101350 

SRVL, P SC, S (29,14)  , SH B ,TA V , TCH ,TOM , TPF , I VL,TS  (2200)  , TSC, TTS , V (29 , 1 4) RE1 01 35 1 

6, VC  (2  9,14, 120)  , VSh  (2  9)  ,VSHX(6)  , WAVEL, XC, XFLOW ,XFLOfc 1(6)  , XFLOWO  (6),FE101352 

7XPD(120)  ,XT  (120)  ,Z  (29) ,ZD  (8)  , ZM , FLOW I ( 1 4)  , FLOWX  (14), PUPIL, SIGMA,  FE10135  3 

6IPRT  (10)  ,APE1,APE2,FINT,ZO,FLO,CABEE,CABEP2,PP,PC,NB,NC,FC  PEI  01 354 

L5= 1 RF 101 355 

BT=. 3 E-B  RE  1 0 1 356 

IF (IPPT (7) . EQ. C) GC  TO  407  PE101357 

WHITE (6,403)  FF101358 

FOFMAT (1HO,48HNOEBALIZED  TEMPERATURE  RISES  OF  MELANIN  GRANULES)  FF1C1359 
WRITE (6,4C5) LTMAX,BT  FE101360 

FORMAT(1H0,5X,6HLTMAX=,I4,2X,3HBT=,E8.3)  PE101361 

IF (DPULSF.GT. 1 .OE-5) GO  TO  494  FF101362 

LPT=DPULSF/. 3E-8  PE101363 

L7=LTM  A X- 1 0 RE101364 

DO  410  L=1,L7,10  E E 1 0 1 365 

L1  = L+ 1 F El  0 1 366 

L2  = L+  9 FE101367 

X 1 = TS  (L)  R El  01 368 
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X2=TS  (L+10) -XI 

F E101 369 

X3  = 0. 

FF1C1 37C 

DO  410  L3=L 1 , L2 

F E 1 0 1 37 1 

X 3=  X 3 ♦ . 1 

PE101372 

4 1 0 

TS  (L3)  =X1+X3*X2  21 

F El  01 373 

LTT  = 2 

FE101374 

XPD (1) =1 .0 

FE101375 

IF  (LPT. GE. LTMAX) GO  TC  472 

PEI  0 1 376 

**♦ 

C AS  F FOP  LPT  LFSS  THAN  LTMAX 

R E 1 0 1 37  7 

440 

IF  (XT  (LIT)  .GE. . 3E-B) GO  TO  442 

F.E1C1376 

XPD  (LTT) = TS (1) 

PF101 379 

LTT=LTT+ 1 

F F 1 0 1 380 

GO  TO  440 

EE101381 

442 

TIMEX=XT  (LIT) 

PEI  01 382 

XX=TIMEX/Br+. 000001 

RE101383 

LX- XX 

FF1 01 384 

PT  = L X 

PEI  01 385 

IF (LX.GT. LPT) PT=LPT 

RE101386 

PO-0. 

PEI  01 367 

IF  (LX.GT. LTMAX)  PO=LX-L?MAX 

PE101 388 

IF  (LX. G~. LPT) GO  TO  443 

PEI  01 38° 

L 1=  1 

F El  01 390 

L2  = LX 

PE101 391 

GO  TO  446 

F E 1 0 1 39  2 

44  3 

IF  (LX .GT. LTMAX) GO  TO  444 

PEI  01 393 

L1=LX+1-LPT 

PE101394 

L2  = L X 

P El  01 395 

GO  TO  44c. 

P F 1 0 1 396 

444 

IF  (LX.  I.T.  LTMAX  + LPT)  GO  TO  445 

BE  1 0 1 397 

l^=l rr 

PEI  01 398 

GO  TO  4-?4 

PE101 399 

4 45 

L1=LX-LPT4 1 

PF.1  01  400 

L2=LTM AX 

PEI  01 401 

4 46 

X2  = PO 

P El  0 1 402 

DO  44  8 L 3 =L 1 , L2 

BE101 403 

4 46 

X 2 = X 2 + TS (L3) 

PEI  01 404 

XPD  (LTT) =X2/PT 

PE101 405 

LTT=LTT4 1 

RE101406 

IF  (LTT.LF.KT) GO  TO  442 

PE101407 

GO  TO  496 

PEI  01 408 

# « * 

CASE  FP?  LTMAX  LESS  THAN  LPT 

PEI  01 409 

472 

TIMEX  = XT  (LTT) 

BF101410 

XX=TIMEX/BT+. C000C1 

RE101411 

LX=  X X 

BE101412 

PT  = LX 

BE101413 

IF  (LX.GT. LPT) PT  = LPT 

BE101414 

P0=0. 

RE101415 

IF  (LX.GT. LTMAX)  PO=LX-LTMAX 

RE101416 

IF  (LX.GT. LPT) GO  TO  473 

BE101417 

L 1=  1 

BF101418 

L2  = LX 

RE101419 

IF  (LX.GT. LTMAX)  L2=ITM AX 

RE10142D 

GO  TO  475 

RE101421 

473 

IF  (LX. LT. LTMAX4LPT) GC  TO  474 

RF101422 

L5=LTT 

BE101423 

GO  TO  444 

BE10142U 

4 74 

L 1 = LX-LPT* 1 

PEI  01 425 

0£ 


L2=LTMAX 
4 75  X2  = P0 

DO  476  L3=L1,L2 
476  X2=X2+TS  (L3) 

XTD  (LTT) = X 2/ PT 
LTT=LTT+ 1 

IF  (LTT. LE. KT) Gf  TO  472 
GO  TO  496 

C ***  END  CALCULATION  IF  TEMPEFATUBES  VERY  UNIFORM 

494  IF  (L5.GT.KT) GO  TO  496 
DO  495  L1=L5,KT 

495  XPD  (LI) =1. 

496  IF (IPRT (7) . FQ.O) til  TUP  N 
WRITE  (6, 4 97)  (XPt  (L 1 ) , LI  = 1 , KT) 

497  FORMAT  (1  HO , 5 X , 4H XPD=/ ( 1 H ,5X,10f8.2)) 

R7TUPN 

FND 

SUBROUTINE  BLOCE 


RE101426 
R El  0 1 427 
RE101428 
RE101 429 
E FI  01 430 
PE101431 
PE101432 
P E 1 0 1 433 
P El  01 434 
PE101 435 
PE101 436 
PE101437 
PE101438 
P E 1 01 4 39 
RE101 440 
RE101441 
PE101442 
FE101 443 


C SUBFOUTINE  BLOOD  COMPUTES  CHANGES  IN  MATRIX  ELEMENTS  A AND  B DUE  PE101444 

C TO  BLOOD  FLOW  PE101445 

COMMON  A (29,3)  , AF,AAV,ACH, APE , ASC, ATS , A VL , B (1 4 , 3)  ,BB,BV(14,3),  PE101446 

1CCNX  (0)  ,CON  (29)  , CUT , DFLOW (6),DPULSE,DF,DT,DTX,DZ,FL,HP(14),  EE  101 447 

2IAB  (29 ,14)  , I BLOOD  (10)  , I FIL , IG , IGX , IHT, I PA , IPC , IPE , I PFOF , IPS , IPT , KE101448 

3IPV , IV  (2  9)  ,JVL,LIM,LPA,LPC,LPE,LPS,LPV,LPX,LTMAX ,K,KN,KT,M,M1,M2,  RE101449 
4M3,N,N1, N3, N4 , N VL , POX , PR (14)  ,PTIME,QP,R  (14) , RCO, FIM , RN , RPE, RRT,  I FI  01 450 

5R VL,P SC, S (29,14)  , SHB, TAV , TCH ,TOM ,TPE ,T VL,TS  (2200)  ,TSC , TTS , V (2 9 , 14) PEI  01 451 
6, VC  (2 9, 14,120)  , V S H (29)  ,VSHX(6)  , * A VEL , XC , X FLOW , X FLOW  I (6)  .XFLCWO  (6)  ,F El  01452 
7XPD  ( 1 20)  , XT  (120)  ,7  (29)  ,ZB(8)  ,ZM,FLOWI (14), FLOWX  (14)  , PUPIL , SIGN A , RF101 453 

8IPPT  (10)  ,APL1,APE2,RINT,ZO,FLO,CABEF,CABEP2,PP,PC,NB,NC,FC  F El  01 454 

DIMENSION  5D  (14)  ,RH  (14)  ,XI  (14) ,XO (1 4)  PE101455 

C *«*  INITIAL  EVALUATION  OF  PARAMETERS  AND  AEFAYS  RE101456 


DO  800  J = 1 , N 3 
BV  (J, 1) =0. 

BV  ( J , 2) =0. 

BV (J , 3) =0 . 

FLOWI  (J) =0. 

800  FLOWX  (J) =0 . 

RH  (1)  =R(2)/2. 

DO  803  J = 2 , J VL 
803  RH  (J)  = (R  (J)  ♦ ? (J+1)  )/2. 

L2  = 2 

DO  810  J= 1 , J VL 

805  IF (DFLOW  (L2) .GT. BH  (J) ) GO  TO  806 
L2  = L2+  1 

GO  TO  805 

806  X1  = DFLOW  (L2) -DFLOW  (L2-1) 

X 2 = K H (J) -DFLOW  (L2-1) 

X3=X2/X1 

XI (J) = X FLOW  I (L2- 1 ) *X3* (XFLOWI (L2) -XFLOWI (L2-1)  ) 

810  XO(J)=  XFLOWO  (L2-1) +X3* (XFLOWO(L2) -XFLOWO (L2-1)  ) 

FLOWX  (1) =0. 

DO  812  J = 2 , J VL 

8 12  FLOWX  (J)  = F L C W X (J-  1 ) ♦ (XI  (J  - 1)  - XO  ( J — 1 ) ) * (P  (J)  * F (J)  - R (J-1)  * R (J-1 ) ) / 
1 (2 . * T VL) 

FLOWX  (JVL  + 1)  = FI.OWX  (JVL) 

L2  = 2 

FLOWI  (1) = XFLOWI  (1)/TVL 


R F 1 01 457 
PE101458 
P F 1 0 1 459 
R E 1 0 1 460 
p F 1 0 1 46  1 
P F 1 0 1 462 
E E 1 0 1 463 
RE 101464 
P FI  0 1 465 
PEI  01 466 
PEI  01 467 
PE101 468 
FE101469 
PEI  01 470 
PE  10 1471 
P E 1 0 1 472 
F El  0 1 473 
FE101474 
PEI  01475 
PE1C1476 
PEI  0 1 477 
RE101478 
R El  01 479 
RE101480 
RE101 481 
RE101U82 
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DO  820  J=2,JVL 

814  IF  (DFLOW  (L2)  .GT.R (J) ) GO  TO  816 
L2=L2+ 1 
GO  TO  814 

816  X4=DFLOW  (L2) -DFLOW  (L2-1) 

X5  = R (J) - DFLCW  (L2- 1 ) 

X6  = X5/X4 

0 2C  FLOW  I (J)  = (X  FLOW  I (L2-1)  + Xb* (X  FLOW  I (L2) -X  FLOW  I (L2-1) ) )/TVL 

DO  823  J=2 , J VL 

8 23  FD(J)  = 1./(F  (J)*  <R  (J+1)  -R  (J-1)  ) ) 

C ***  CALCULATE  CHANGES  IN  MATRIX  ELF.MFNTS  A AND  B DUE  TO  BLOOD  FLOW 
BV  (1  , 1) =0. 

BV ( 1 , 2) =- SUB* FLOW I (1) /2. 

BV  (1 , 3) =0. 


PEI  01 483 
Prl01484 
RF101485 
BL1 01 486 
P El  0 1 487 
FF101488 
RE101489 
BE101490 
PE  1 0 1 49 1 
PEI  01 492 
RF101 493 
B F 1 0 1 494 
PF101 495 
PF1 01496 


BB=-SHB»XFLOW/2. 

DO  925  J = 2 , J VL 

BV  (J, 1) =SHB*RD  (J) *FLOWX  (J) 

BV  (J, 2) =SH3*PD  (J)*  (FLOWX (J-1) -FLOWX  (J>1) ) /2 . - SHS* FLOW  I ( J) /2 . 
825  BV (J , 3 ) =- SHB*PD  ( J ) * FLO WX  ( J) 

DO  835  I =1 P A , M 
835  IV  (I) =0 

DC  340  L3=1,NVL 
L4=1BL00D (L3) 

840  IV  ( L 4 ) =1 

DO  845  I=IPA ,LPS 
DO  942  J= 1 , J VL 
842  IAB  ( I , J) =0 

IF (JVL. "Q. N) GO  TO  845 
L 1 = J VL  + 1 
DO  343  J=L1,N 
343  IAB(I,J)=1 
345  CONTINUE 

DO  350  I=IPT,M 
DO  950  J = 1 , N 
850  IAB (I , J) =1 
RETUPN 
END 


PF101497 
PEI  01 498 
PEI  01 499 
F.E1C1500 
RE1015C1 
RE1015C2 
R E 1 0 1 503 
P E 1 0 1 504 
F El  0 1 50 5 
EE101506 
P F 1 0 1 507 
PE101508 
RF101509 
RE101510 
PEI  01511 
RE101512 
PEI  01 51 3 
PEI  01 51 4 
RE101515 
RE101516 
RF101517 
PE101518 
PF101519 


1519  RECORDS  PRINTED 
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n n n n n 


2 

3 

4 

5 

6 

7 

8 
9 

3 CO 


C *+* 


RETINAL  MODEL  IITRI  RE200001 

VERSION  2 14  NOV  1975  RE200002 

TEMPERATURE  AND  DAMAGE  PREDICTIONS  IN  AND  ABOUT  RET  CAUSED  BY  LASERS  PE200003 
EFFECTS  OF  MELANIN  GRANULES  NOT  INCORPORATED  IN  PROGRAM  RE200004 

RE200005 

COMMON  A (29,3)  , A AV , ACH , APE , ASC , ATS , AVL , B (1 4 ,3 ) , BB , BV ( 1 4 , 3) , RE200006 

1CONX  (6) , CON  (29) ,CUT,DFLON  (6)  ,DPULSE ,DR , DT , DTX , DZ , FL , HP (14) , RE200007 

2IAB  (29,14) , IBLOOD  (10)  ,IFIL, IGX , IHT, IPA , IPC , IPE, IPROF , IPS, IPT , FE200008 

3IP V , I V (29)  ,JVL,LIM,LPA,LPC,LPE,LPS,LPV,LPX,K,KH,KT,M,H1 ,H2,  RE200009 

4H3,N,N1,N3,N4,NVL,POX,PR  (14) , P?IME,0P,R  (14) , R CO, RIM , PN , RPE ,BBT,  RE200010 
5RVL , RSC, S (29,14)  ,SHB , TAV , TCH , TOM , TPE ,TVL, TSC, TTS , V (29 , 1 4)  RE200011 

6, VC  (29,14,  120) ,VSH  (29) ,VSHX  (6) , HA VEL , XC , XFLON , XFLONI (6) ,XFLOWO (6)  ,RE200012 
7XT  (120) ,Z  (2  9) ,ZD  (8)  ,ZM , FLOWI (14)  ,FLO«X  (14) , PUPIL, SIGMA , RE200013 

8IPRT  (10) , APE1, APE2,RINT,ZO,FLO,CABEF,CABER2,PP,PC,NB,NC,FC  BE200014 

DIMENSION  CXC  (14) ,CXR  (29) .DAMAGE (2,2) ,DXC(14)  ,DXF  (29) ,FTINE(38) , HE200015 

1 FXC  (14) , FXR  (29) ,ID(23C) ,JD(230) ,KTT(38)  ,NPT(38) ,NPULSE(7) ,NRUN(7) ,BE200016 
2QD(29, 14)  , REPFT  (7) .TIMEX (10)  , XCT  (38) ,XQD(29,14) ,VE  (27, 120, 1) , RE200017 

3VXX  (29,14)  , VZ  (27 ,42,8,1)  ,ZT(8) , ZTT  (8 ) , S AVRGV ( 10)  RE200018 

REAL  LESION  RE200019 

FORMAT  (10F7. 3)  RE200020 

FORMAT  (F7. 4, 317)  RE200021 

FORMAT  (1 1F7. 2)  RE200022 

FORMAT  (1017)  RE200023 

FORMAT  (P7. 2,17, 2F7. 2)  RE200024 

FORMAT  (1 0E7 . 2)  RE200C25 

FORMAT  (17, 3E7. 2)  RE200026 

FORMAT  (F7. 2,217, F7. 2)  RE200027 

EEAD(5,4,END=200)  (FTIME  (L)  ,L=1 ,38)  RE200028 

READ  (5,5) IPRT  RE200029 

READ  (5,3) RIM,LIB,IFIL,IGX  RE200030 

READ  (5, 9) R M AX, LIM AX, MAXPFT, LESION  RE200031 

SET  VALUES  FOR  MTEST , N , N1 , N3 , N4 , AND  DR  RE200032 

MTE  ST=0  RE200033 

N1 =4  FE200034 

N=N 1+9  RE200035 

N3=N+ 1 RE200036 

N4=N 1 + 1 RE200037 

READ  (5,8) IPROF, PON, CUT  RE200038 

DR=LESION/LIM  RE200039 

IF (IPROF. EQ.O) DR=RIM/(LIM-.5)  RE200040 

RE AD  (5 , 7) DPULSE  RE200041 

BEAD  (5,5) NTEST , (NRUN  (L)  , L=1 , NTEST)  RE20C042 

READ  (5,  7)  (REPET  (L)  ,L=1 .NTEST)  PE200043 

READ  (5,  5)  (NPULSE  (L)  ,L=1 .NTEST)  RE200044 

READ  (5,5) ID1 ,ID2 , JD1 ,JD2,ITYPE  RE200045 

LPX=1  RE200046 

IF  (NTEST. EQ.1. AND. NPULSE (1)  .EQ.1)LPX=0  RE200047 

XDPULS=DPULSE  RE200048 

XXQ=1 . RE200049 

IF  (DPULSE. GT. .3E-8) GO  TO  10  RE200050 

ADJUST  POWER  AND  PULSE  WIDTH  FOR  EXPOSURES  WITH  PULSES  LESS  THAN  RE200051 
. 3E-8  SEC  RE200052 

XXQ=. 3E-8/DPULSE  RE200053 

POW=POW*DPULSE/. 3E-8  RE200054 

DPULSE=. 3E-8  RE200055 

READ  (5,4) T0.EDT1 ,EDT2  RE200056 

READ  (5, 4 ) TOM, APE, AVL, ACH, ASC, ATS, RCO.RRT, RSC, RPE, W A VEL  RE200057 


*** 

*4* 


10 


c *** 


c *** 


c *+* 

11 


12 


13 

14 

C *** 


c **+ 


c *** 


READ  (5,4) TAV,TPE,TVL,TCH,TSC,RVL 

AAV=- ALOG  (TOH) /TAV 

READ  (5,  4)  (CONX  (L)  ,L=1 ,6) 

READ  (5,4)  (VSKX  (L) ,L=1 ,6) 

READ  (5,5)  (NPT(L)  ,L=1,38) 

READ  (5,2)  (XCT(L)  ,L=1,38) 

READ  (5,5)  (KTT  (L) ,L=1 ,38) 

COMPOTE  DT,KM,KT,NP,PTIME,TIHE,  AND  XC 
LI = ALOG  (DPOLSE)/. 6931 5+29. 

IF  (LI .LT. 1) LI  = 1 
IF  (LI .GT. 38) L1=38 
IF (LPX.EQ. 1) GO  TO  11 

SINGLE  PULSED  EXPOSURES  — 

XC=XCT  (LI) 

NP  = NPT  (LI) 

KT=KTT (LI) 

DT=DPULSE* (XC- 1 . ) / (XC**NP-1 . ) 

TIME=DT* (XC**KT-1.)/(XC-1.) 

GO  TO  13 

MULTIPLE  PULSED  EXPOSURES 

XC= 1.4 

NP=5 

X1=0. 

DO  12  L= 1 , NTEST 

IF (XI .LT.NPULSE(L) /REPET (L) ) X1=NPULSE (L) /REPET (L) 

CONTINUE 

TIME=FTIME (LI) *X1 
DT=DPULSE*  (XC-1.)/(XC**NP-1.) 

KT=ALOG  (1 .+TIME*  (XC- 1 . ) /DT) /ALOG (XC) +1 . 

PTIHE=DPULSE/NP 
KT=KT+1 
KM=NP+ 1 

IF(KT.GT.119)WFITE(6,14)KT 

FORMAT  (1H0,3HKT=, 13, 2X,22HTIME  DIMENSION  TOO  LOW) 

IF (KT.GT. 119) STOP 
CALC.  DZ  AND  I INDICES 
M1=6 

M=2*H1*16 
M2=M/2 
H3=M+ 1 
IPE=H2-M 1+2 
DZ=TPE/M1-1 .E-25 
IPA=2 

STORE  AXIAL  DISTANCES  TO  INTERFACES  OF  EYE 
ZD  (1 ) =1 . E-25 
ZD  (2) =TA V 

ZD  (3) =ZD  (2) +RPE*TPE 

ZD  (4) =ZD  (3) ♦ (1.-RPE) *TPE 

ZD  (5) =ZD  (4) +TVL 

ZD  (6) =ZD  (5) +TCH 

ZD  (7) =ZD  (6) +TSC 

ZD  (8) =ZD  (7) +10. 

CALL  GRID 
NVL=LPV-IPV+1 

CALCULATE  AND  STORE  I,J  INDICES  AT  WHICH  TEMPERATURES  ARE  PRINTED 

ID1=ID1+IPE 

ID2=ID2+IPE 


RE200058 
RE200059 
RE200060 
RE200061 
RE200062 
RE200063 
RE200064 
RE200065 
RE200066 
RE200067 
RE200068 
RE200069 
RE200070 
RE200071 
RE200072 
RE200073 
RE200074 
RE200075 
RE200076 
RE200077 
RE200078 
RE200079 
RE200080 
RE200081 
RE200082 
RE200083 
RE200084 
RE200085 
RE200086 
RE200087 
RE200088 
RE200089 
RE200090 
RE200091 
RE200092 
RE200093 
RE200094 
RE200095 
RE200096 
RE200097 
RE200098 
RE200099 
RE200100 
RE200101 
RE200102 
RE200103 
RE200104 
RE200105 
RE200106 
RE200107 
RE200108 
RE200109 
RE200110 
RE2001 1 1 
RE200112 
RE200113 
RE200114 


on 


IF(IDI.LT.IPA)  ID1=IPA  FE200115 

IF  (ID2.GT.M)ID2=M  RE200116 

IF(JD2.GT.N)JD2=N  *2200117 

IF(IPRT(1)  .EQ.0)GO  TO  23  RE200118 

WRITE  (6,15) ID1 , ID2, JD1 , JD2  RE200119 

3 FORMAT  (1H0,5X,4HID1=,I3,3X,4HID2=,I3,3X,4HJD1=,I2,3X,4HJD2=,I2)  RE200120 

WRITE  (6,16) DR, DZ  RE200121 

■ FORMAT(1H0,5X,3HDR=,E11.4,2X,3HDZ=,E11.4)  RE200122 

WRITE  (6,17) IPA,IPC,IPE,IPS,IPT,IPV,LPA, LPC ,LPE,LPS,LPV  RE200123 

J F0RMAT(1H0,5X,4HIPA=,I3,2X,4HIPC=,I3,2X,4HIPE=,I3,2X,4HIPS=,I3,2X,BE20o124 
1 4HIPT= ,I3,2X,4HIPV=,I3/1H  , 5X ,4HLPA  = , I 3 , 2X , 4HLPC= , 1 3 , 2X , 4HLPE* , 13 , RE200 1 25 
22X,4HLPS=,I3,2X,4HLPV=,I3)  RE200126 

WRITE  (6,22) M, Ml ,N,N1  RE200127 

l FORMAT  (1H0,5X,2HM=,I2,2X,3HM1=,I2,2X,2HN=,I2,2X,3HN1=,I2)  RE20r 128 

WRITE  (6,18)  (R  (J)  , J= 1 , N3)  RE200129 

3 FORMAT  (1H0,5X,2HR=/(1H  ,5X,10F8.4))  RE200130 

WRITE  (6 , 19)  (Z  (I)  ,1=1, M3)  RE200131 

3 FORMAT  (1H0,5X,2HZ=/(1H  ,5X,10F8.4))  RE200132 

3 DO  20  LI = 1 , N VL  RE200133 

) IBLOOD  (L1)=IPV+L1-1  RE200134 

K CALC.  NORMALIZED  LASER  PROFILES RE200135 

DO  21  L= 1 , N3  RE200136 

I HR  (L) =0 . RE200137 

POX=POW  PE200138 

CALL  IMAGE  RE200139 

DO  27  J=1 ,N3  RE2001 40 

DO  27  1=1, M3  RE200141 

V (I, J) =1 .E-10  RE200142 

1 S(I,J)=0.  RE200143 

READ  (5,2) SHB,XFLOW,CFLOW  RE2  00144 

« SET  BLOOD  FLOW  RATES  ENTERING  AND  LEAVING  VASCOLAR  LAYER  AS  RE200145 

* FUNCTION  OF  RADIAL  DISTANCE  RE200146 

X2=CFLOW/  (3. 1416  + RVL*RVL)  RE200147 

DFLOW (1) =0 . RE200148 

X4=0 . RE200149 

DO  30  L 1 =2 , 6 RE200150 

X4=X4+.1  RE200151 

) DFLOW  (LI) =X4  RE200152 

DO  31  LI =1 , 6 RE2001 53 

XFLOWI  (Li) =X2  RE200154 

1 XFLOWO  (Li) =X2  RE200155 

DO  34  1=1, M3  RE200156 

DO  34  J=1 ,N3  RE2001 57 

3 VC  (I, J, 1 ) = 1 . E-10  RE200158 

XPOW=XXQ*POW  RE200159 

READ  (5,8) KTYPEO  RE200160 

READ  (5,8) KTYPE  RE200161 

L1=KTYPE  RE200162 

IF  (KTYPE. EQ.O) L1  = 1 RE200163 

READ  (5,7)  (TIMEX (K) ,K=1 , LI)  RE200164 

READ  (5,5) III ,112,113, JJ1  ,JJ2  RE200165 

< START  OF  TEMPERATURE  CALCULATIONS  FOR  ONE  PULSE.  TO  BE  USED  EITHERRE200166 

* FOR  MULTIPLE  OR  SINGLE  PULSED  EXPOSURES  RE200167 

RE200168 

XT  (1 ) =0 . RE200169 

DTX=DT  RE200170 

KTX=KT+ 1 RE200171 


91 


r 


j 


fc.'! 

f ?U 


DO  36  K=2 , KTX  RE200172 

XT  (K) =XT  (K-1) +DT  RE200173 

36  DT=XC*DT  RE200174 

IKX=TIME**EDT1+EDT2  RE200175 

IF  (IKX.LT. 1) IKX=1  RE200176 

XX=2*IKX  RE200177 

K=2  RE200178 

IHT=2  RE200 179 

ITYPEX=ITYPE  RE200180 

CALL  BLOOD  EE200181 

38  DT=XT  (K) -XT  (K-1)  RE2C0182 

IF  (K.GT.KM) QP  = 0.  RF200183 

CALL  HTXDEP  EE200184 

IF  (K . GT. 2) GO  TO  41  RE200185 

IF(IPRT(2) .EQ.O)GO  TO  335  RE200186 

WRITE  (6,301)  PF200187 

301  FORMAT(1HO,13HLASER  PROFILE)  RE200188 

IF (IPROF. EQ.O) WRITE (6,302) BIB  RE200189 

302  FORMAT  (1  HO , 5X ,4HRIM= , El  0 . 3)  RE20019C 

IF  (IPRCF.EQ.  1) WRITE  (6,303) SIGBA , RIB , COT  PE2C0191 

303  FORMAT(1H0,5X,6HSIGMA=,E10.3,5X,4HRIH=,E10.3,5X,4HC0T=,E10.3)  RE200192 

IF (IFIL . EQ . 1) WRITE  (6,304) RI NT , ZO , FLO ,C ABER ,CABER2 , PP , PC , NB , NC , FC,  RE200193 

1WAVEL  RE200194 

304  FORMAT(1HO,5X,5HRINT=,E10.3,3X,3HZO=,E1C.3,3X,4HFLO=,F6.3/1H  ,5X,  RE200195 

16HCABER=,E10.3,3X,7HCABER2=,F7.0, 3X , 3HPP=, F6 . 3/1 H , 5X, 3HPC=, F6 . 3,  RE200196 
23X,3HNB=,F7.3,3X,3HNC=,F7.3/1H  , 5X , 3HFC=, F6 . 3 , 3X , 6H WA VEL= , F7 . 1 ) RE200197 

IF  (IFIL. EQ. 1) GO  TO  306  RE200198 

IF (IPROF . EQ. 2) WFITE (6,305) RINT  RE200199 

305  FORMAT  (1  HO  , 5X  , 5HEINT  = , El  0 . 3)  RE200200 

306  WRITE (6, 307) QP  RE200201 

307  FORMAT  (1HC,5X,3HQP=,E10.3)  RE200202 

WRITE  (6,3  08)  (HE  ( J)  ,J=1,N)  PF20020  3 

308  FORMAT  (1  HO , 5X  , 3HHR=/ ( 1 H , 1 0X , 1 0E 1 0 . 3) ) RE200204 

335  IF  (IPRT(3)  .EQ.O)GO  TO  340  RE2002C5 

WRITE  (6,309)  RE200206 

309  FORMAT  (1H0, 19HDATA  IDENTIFICATION)  RE200207 

WRITE  (6,310)  (REFET(L)  ,L=1,NTEST)  RE200208 

310  FORMAT  (1  HO , 5X , 6 HREPET=/ ( 1 H , 5X , 1 0E1 0 . 3) ) RE200209 

WRITE  (6,311)  (NPULSE  (L)  ,L=1 ,NTEST)  RE200210 

311  FORMAT  (1  HO , 5 X , 7HNPULSE=/ ( 1 H ,5X,10I8))  RE200211 

WRITE  (6, 312) AAV,ACK, APE, ASC, ATS , RCO , FRT , RPE , TOM , A VL , TA V ,TCH , TPE,  RE200212 

1 TSC , T VL, IGX, IFIL, IPROF, LIM,N TEST, PO W , X DPULS ,R IM , RMAX , TIME, CFLOW,  RE200213 
2XFLOW,SHB,EDT1, EDT2 ,DT,KM,KT,PTIME,XC,IKX,APE1,APE2,RVL,  RE200214 

3PUPIL,T0,LIMAX,MAXPPT  RE200215 

312  FORMAT  (1  HO, 5X,  4HA AV  = , F7 . 1 , 2 X,4H ACH  = ,F7 . 0 , 2X, 4HAPE= , F7 . 0 , 2X , 4H ASC=RE200 21 6 

1,F7.G,2X,4HATS=,F7.C/1H  , 5X , 4HRC0= , F7 . 4 , 2X , 4HRRT= , F7 . 4 , 2X , 4HRPE=,  RE200217 
2F7. 4,2X,4HTOM-,F7.4,2X,4HAVL=,F7. 0/1H  , 5X , 4HT A V= , E9 . 3 , 2X , 4 HTCH= , RE200218 

3E9 .3, 2X,4HTPL=,E9.3,2X,4HTSC=,E9.3,2X,4HTVL=,E9.3/1H  , 5X ,4HIGX=, I2RE20021 9 
4 ,2X,5HIFIL=, 12,2X,6HIPROF=,I2,2X,4HLIH=,l2,2X,6HNTEST=, 12/1 H ,5X,  RE20022C 
54  HPOW  = , E9 . 3,2X,7HDPULSE  = ,E9. 3 , 2X, 4HFIM  = , F7 . 4 , 2X, 5HRM AX  = ,F7 . 4 , 2X , RE200221 

65HTIME=,E9. 3/1H  , 5X , 6 HCFLOW= , F7 . 4 , 2 X , 6HXFLCh= , F7 . 4 , 2 X, 4HSHB= , F7 . 2 , RE200222 
72X,5HEDT1=,F7.4,2X,5HEDT2=,F7.4/1H  ,5X,3HDT=,E9.3,2X,3HKH=,I3,2X,  RE200223 
83HKT=,I3,2X,6HPTIME=,E9.3, 2X , 3HXC= , F5 . 1/1 H , 5X , 4HIKX= ,1 2 , 2X , RE200224 

9 5HAPE1=,F8.2,2X,SHAPE2=,F8.2  /1H  ,5X,4HRVL=,  RE200225 

1F6.3,2X,6HPUPIL=,F6.3,2X, 3HT0=,F5. 1 , 2 X , 6HLI M A X= , 12 , 2X , 7HHAXPRT=,  RE200226 
212)  PE200227 

34C  IF(IPRT(4) .EQ.O)GO  TO  355  FE200228 
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c 

c 


c 


WRITE (6,313) 

RE200229 

313 

FOEHAT(1HO,30HBLOOD  FLOW  AND  HEAT  DEPOSITION) 

RE200230 

WRITE (6, 314) (FLOWI (J) , J=1,JVL) 

RE200231 

314 

FORMAT  (1HO,5X,6HFLOWI=/(1H  ,5X,10E10.3) 

) 

RE200232 

WRITE  (6,315)  (FLOWX(J)  ,J=1,JVL) 

PE200233 

315 

FORMAT  (1HO,5X,6HFLOWX=/(1H  ,5I,10E10.3) 

) 

RE200234 

WRITE  (6,316) 

RE200235 

316 

FORMAT  (1H  ) 

RE200236 

DO  318  I =IP A , M 

RE200237 

WRITE  (6,317)  (S(I,J)  ,J=1,N) 

RE200238 

317 

FORMAT  (1 H ,5X,2HS=,10E8.3) 

RE200239 

318 

CONTINUE 

RE200240 

355 

IF  (IPRT  (5)  . EQ.O) GO  TO  41 

KE2G0241 

WRITE (6,319) 

RE200242 

319 

FORMAT  (1HC, 17HTEMPERAT0RE  RISES) 

RE200243 

JCNT=JD2-JD1+1 

RE200244 

IF  (JCNT.GT. 9) GO  TO  40 

R E200245 

GO  TO  41 

RE200246 

40 

JJCNT=JCNT-9 

RE200247 

JJD2=JD2- JJCNT 

RE200248 

JJD2P 1 -J JD2+ 1 

RE200249 

41 

IF  (IPRT  (5)  .EQ.O) GO  TO  356 

RE200250 

WRITE  (6,42) XT (K)  ,K 

RE200251 

42 

FORMAT  (1H0,5X,5HTIME=,E11.4,3X,2HK  = ,I3) 

PF200252 

*** 

CALCULATE  TEMPERATURE  RISE  (MATRIX  REDUCTION  ALGORITHM) 

RE200253 

*** 

COLUMNS  (NORMAL) 

EE200254 

356 

IK  = 1 

RE200255 

43 

DO  45  I=IPA,M 

PE200256 

W=XX* VSH (I) /DT 

RE200257 

DO  44  J= 1 , N 

RE200258 

FXC  (J)  =W+CON  (I)*B  (J,  2) -BY  (J  , 2)  * IV  (I)-BB*IAE3  (I,J) 

BE200259 

IF  (J.GT.  1)  FXC  (J)  =FXC  (J)  + (CON  (I)  *B  (J,1)  + 

BV (J,1) *IV (I) ) *CXC  (J-1) 

RE200260 

CXC  (J) =-  (CON (I) * B (J,3) +BV (J, 3) *IV  (I) ) /FXC  (J) 

PE200261 

SUH=  (W-  (A  (1,2) -BV  (J,2)*IV  (I) -BB*IAB  (I, J) ) ) *V (I,J) +A  (1,1) *V  (1-1 

,J)  +PE200262 

1 A (1,3) *V  (I  + 1,J)+S  (I,J) 

RE200263 

DXC  (J) =SUM/FXC (J) 

RE200264 

IF  (J.GT. 1) DXC  (J)  = (SUM+  (CON (I) *B (J , 1 ) + B V (J , 1 ) * I V (I) ) *DXC ( J- 1 ) ) /FXC (RE200  26  5 

1J) 

RE200266 

44 

CONTINUE 

RE200267 

vx=o. 

RE200268 

DO  45  L=1 , N 

RE200269 

J=N+1-L 

PE200270 

VX=DXC  (J)-CXC  (J)  *VX 

RE200271 

45 

VXX (I, J) =VX 

RE200272 

DO  46  I=IPA , M 

PE200273 

DO  46  J=  1 , N 

RE200274 

46 

V (I , J) =VXX  (I , J) 

RE200275 

*♦* 

ROWS (NORMAL) 

RE200276 

CXR (IPA- 1 ) =0 . 

RE200277 

DO  50  J= 1 , N 

RF200276 

DO  48  I=IPA,B 

PF200279 

W=XX*VSH  (I) /DT 

RE20028C 

FXR  (I) =W*A  (1,2) -BV  (J,2) *IV (I)  -BB*IAB (I, 

J)  ♦ A (I  , 1)  *CXR  (1-1) 

RE200261 

CXR  (I)  =-  A (1 , 3)  /FXR  (I) 

RE200282 

SUM=  (W-  (CON  (I)*B  (J,2)-BV  (J,2) *IV (I) -BB* I AB (I, J) ) ) *V (I , J)  ♦ (CON (I)  * RF200  283 

IB  (J,3) +BV  (J,3)*IV  (I) ) *V  (I, J*1 )+S (I,J) 

PE200284 

IF (J.GT. 1) SUH=SUM+  (CON (I) *B ( J, 1 ) +BV (J, 1 ) *1 V (I) ) *V (I , J-1 ) 

RE200285 

i 
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DXR  (I) =S  UM/FXR  (I) 

IF  (I.GT.  IPA)  DXR  (I)  = (SUM+A  (1,1)  *DXF.  (1-1)  )/FXR  (I) 

48  CONTINUE 
VX  = 0 . 

DO  5C  L=IPA , K 
I=R+IPA-L 

VX-DXR  (I)  -CXK  (I) *VX 
VC  (I, J,K) =VX 

50  VXX  (I, J) =VX 
DO  51  I=IPA,« 

DO  51  J= 1 , N 

51  V (I,J) =VXX  (I,J) 

IK=IK+ 1 

C ***  RECYCLE  TEMPERATURE  CALCULATIONS 
IF  (IK.LE.IKX)GO  TO  43 
IF (K . EQ. KM) GO  TO  62 

IF (ITYPEX.LT. ITYPE.AND.K.LT.KT) GO  TO  66 

62  IF  (IPRT  (5)  .EQ.O) GO  TO  357 
WRITE  (6, 63)  <R  (J)  , J=JD1 , JD2) 

63  FORMAT  (1 H , 1 3X, 2HF  = , 9F1 3 . 5/1 H , 15X, 30H 

1 — ) 

DO  65  I=ID1 , ID2 
X1=Z  (I) -Z  (IPE) +DZ/2. 

IF  (JCNT.GT. 9) GO  TO  57 

WRITE  (6,64) XI , (VC  (I, J , K)  , J=JD1 , JD2) 

GO  TO  65 

57  WRITE  (6,64)  XI  , (VC (I,J,K)  ,J  = JD1 ,JJD2) 

WRITE  (6,64)  XI , (VC  (I  ,J,K)  ,J=JJD2P1 ,UD2) 

64  FOR  MAT  (1 H , 3X , 2HZ= ,F8 . 5 , 2X , 1 P9E 1 3 . 6) 

65  CONTINUE 
357  ITYPEX=0 

66  K=K+ 1 
ITYPEX=ITYP£X+1 

IF  (K. LE. KT) GO  TO  38 
ITYPEX=ITYPE 

IF(IPRT(6) .EQ.O) GO  TO  365 
WRITE  (6, 3-20) 

320  FORMAT  (1 HC , 28HNORMALIZED  TEMPERATURE  RISES) 

DO  70  K=2 , KT 

IF (K . EQ . KM) GO  TO  67 

IF (ITYPEX.LT. ITYPE.AND.K.LT.KT) GO  TO  70 

67  X1=1 . 

WRITE  (6,321) XT  (K)  ,K,X1 

3 21  FORMAT  (1  HO , 5X  , 5HTIM E= , E 1 1 . 4, 3X, 2HK= , 13, 3X , 6HPOWEF  = , El  1 . 4 , 5H WATTS) 
WRITE  (6,63)  (R(J)  ,J=JD1,JB2) 

JCNT=JD2-JD1+1 
IF  (JCNT. GT. 9) GO  TO  380 
GO  TO  381  » 

380  JJCNT=JCNT-9 
JJD2=JD2-JJCNT 
JJD2P1=JJD2+1 

381  DO  69  I = ID’1 , ID2 
DO  68  J=JD1 , JD2 

68  V (I, J) =VC  (I,J,K) /POW 
X1=Z  (I)-Z  (IPE) +DZ/2 . 

IF  (JCNT. GT. 9) GO  TO  382 

WRITE  (6,64) XI  , (V  (I, J)  ,J  = JD1,JD2) 
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69 

70 
330 

365 


73 

C *** 


74 

75 

366 

367 

368 

369 


76 
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C *** 

C 

C *** 


GO  TO  69 

WRITE (6,64)  XI,  (V  (I, J)  , J=JD1 ,JJD2) 

WRITE (6,64) XI,  (V  (I,J)  , J= J JD 2P 1 , JD2) 

CONTINUE 
ITY  PEX=0 
ITYPEX  = ITYPEX*-1 

FORMAT (1HO,61HDIHENSION  OF  ARRAYS  ASSOCIATED  KITH  ARGUMENT  LI 
1 TOO  SMALL) 

CONTINUE 

READ (5,4) (DABAGE (L2,1) , DAMAGE (L2 , 2) ,L2=1,2) 

WRITE  (6,73) KAVEL, DAMAGE (1 ,1)  , DAMAGE  (1 ,2) , DAMAGE  (2,1)  , 

1 DAM AGE (2,2) 

FORMAT  (1H0,5X,11HKAVELENGTH=,F7. 1 , 2HNM , 3X , 7HD AM AGE= , 4 F9 . 0 ) 
CALCULATE  I,J  INDICES  AT  WHICH  DAMAGE  CALCULATIONS  APE  TO  BE 
JM  = 0 

DO  74  J= 1 , N 

IF (R (J) . LT. RMAX+ .000001) JM=J+1 

CONTINUE 

X1=0. 

DO  75  I=IPA , M 

IF  (VC  (I, 1 , KM)  .GT .XI) IMAX  = I 

IF  (VC  (I, 1 , KM)  . GT . X 1 ) X1=VC(I,1 ,KM) 

CONTINUE 
L = 0 

GO  TO  (366,367,368) ,MAXPFT 

LIMAX1=2*LIMAX 

LIMAX2=0 

GO  TO  369 

LIMAX1=LIMAX 

LIM AX2=LI MAX 

GO  TO  3 69 

LIMAX1 =0 

LIMAX2=2*LIMAX 

ID1=IMAX-LIMAX1 

ID2=IMAX+LIMAX2 

IF (ID2.GT.28) ID2=28 

DO  76  I=ID 1 , ID2 

DO  76  J= 1 , JM 

L=L+1 

ID (L) =1 

JD (L) =J 

LIJ= (ID2-ID1+1)*JM 
DO  505  LL 1 5=1 , 1 0 
SAVRGV (LL 1 5) =0. 

IF  (LPX . EQ. 0) GO  TO  125 
IF  (LIJ.GT. 27) WRITE (6, 33  0) 

IF  (LIJ.GT.27) GO  TO  300 
IF (IPRT(8)  .EQ.O) GO  TO  370 
TEMPERATURE  AND  DAMAGE  EVALUATIONS 


FOR  MULTIPLE  PULSES 


EVALUATE  TEMPERATURE  RISES  WITHOUT  GRANULES 
DO  77  L= 1 ,LI J 
I=ID  (L) 

J= JD  (L) 

VE  (L, 1 , 1 ) =0 . 

DO  77  K=2 , KT 
VE  (L,K,1)=VC(I,J,K) 
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77 

CONTINUE 

RE200400 

X60=(XC-1.)/DTX 

RE200401 

X61 =ALOG  (XC) 

RE200402 

370 

LI  3 = 0 

RE200403 

371 

LI 3 = L1 3+  1 

RE200404 

X3  = DPULSE+ (NPULSE  (LI 3) - 1 ) /REPET  (Li 3) 

RE200405 

WRITE  (6,78) NRUN (LI 3)  , X3 , XDFULS , NPULSE (LI 3)  , RE PET  (LI  3) 

RE200406 

78 

FORNAT(1H0,5X,5HNRUN  = ,I3,2X,13HTRAIN  LENGTH= , El 0 . 3 , 3HSEC , 2X , 

12HPULRE200407 

1 SE  WID?H=,E10.3,3HSEC/1H  , 5X , 1 7H NUMBER  CF  PULSES= , 1 5 , 3X , 1 6 HREPETITRE200408 


2I0N  PATE=,E10.3,1 OH PULSE S/SEC) 

IF  (IFIL.EQ.O)GO  TO  80 
WRITE  (6,79) PIM, LESION 

79  FORMAT  (1 H ,5X,12HBEAH  R ADIOS  = , El C . 3 , 2HCB, 5X , 1 4HLESION 
1 3 , 2HCM) 

GO  TO  82 

WRITE  (6,81) PIN, LESION 

FOPHAT  (1 H , 5X , 1 3 HIH AGE  E ADIUS=, El  0 . 3 , 2HCH , 5X , 1 4HLES ION 
1.3, 2HCM) 


80 

61 

82 


83  I 


64 


C 
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CALCULATIONS RE 2004 31 
RE200432 


86 

C *** 
C ♦** 


87 


IF  (IPRT  (8)  . EQ.O) GO  TO  108 
TC=1 ./REPET  (LI 3) 

NPL  = NPULSE  (L13) 

KX=NP*3 
IN=1 

IF (NPL/IN.LT.20) GO  TO  84 
IN  = IN  + 2 
GO  TO  83 
XI =NPL 

INX= . 5*X 1/1 N 

L1=ALOG (D PULSE) /. 693 15*29. 

IF (LI . LT . 1) L1=1 
INXX=FTIME(L1)*INX 

STORE  TINE  INTERVALS  AND  LOGS  OF  INTERVALS  FOE  DAHAGE 
ZT ( 1 ) =PTIME/2 . 

ZTT (1 ) =ALOG  (IN*PTIME)  RE200433 

DO  85  L3=2 , NF  RE200424 

ZTT (L3) =ALOG  (IN*PTINE)  EE200435 

ZT (L3) =ZT  (L3-1) +PTIHE  RE200436 

L1=NP*1  EE200437 

X3= (TC-DPULSE) / (KX-NP)  RE200438 

ZT (LI) =DPULSE*X3/2.  RE200439 

ZTT (LI) =ALOG  (IN*X3)  RE200440 

L1=L1+1  RE200441 

DO  86  L3=L1,KX  PE200442 

ZTT (L3) =ALOG  (IN*X3)  RE200«43 

ZT (L3) =ZT (L3-1) *X3  RE200444 

CALCULATE  TEHPEEAIUEE  RISES  ASSOCIATED  WITH  L3-TH  TINE  INTERVAL  RE200445 
FOLLOWING  (L6- . 5) *IN- . 5 PULSE  RE200446 

DO  95  L=1 , LIJ  RE200447 

DO  95  L3=1,KX  RE200448 

X1=0.  RE200449 

Li = 1 ♦ IN/2  RE200450 

L7= 1 RE200451 

X3=  (L7-1 ) *TC*ZT (L3)  RE200452 

K=ALOG  (X3*X60+1.)/X61*1 . RE200453 

X5=VE  (L,K,1)+  (X3-XT(K)  )*  ( VE  (L , K*1  , 1 ) - VE  (L,R,1)  )/(XT  (K*1)-XT(K))  P.E200454 

X1=X1 *X5  FE200455 

IF(X5.LT. .0001*X1)GC  TO  88  RE200456 


96 


L7  = L7 ♦ 1 

IF (L7 . LE . LI ) GO  TO  87 
88  VZ  (L, 1 ,L3, 1) =X1 
DO  93  L6=2,INXX 
IF  (X5 . LT . .0001*X1)GO  TO  93 
X1  = VZ  (L , L6- 1 ,L3 , 1 ) 

L2=L1 ♦ 1 
L1=L 1 *IN 
L7=L2 

90  X3=  (L7-1)*TC*ZT(L3) 

K=ALOG  (X3*X60*1.)/X61*1. 

X5  = VE  (L, K,  1 ) ♦ (X3-XT(K)  )*  (VE (L, K+1 , 1 ) - VE (L , K , 1 ) )/(XT  (K+1) 
X1=X1 +X5 

IF  (X5.LT. . 000 1*X1) GO  TO  93 
L7=L7+1 

IF  (L7.LE.L1) GO  TO  90 
93  VZ  (L,L6,L3, 1) =X1 
L1=INX+1 

DO  94  L6=L1 ,INXX 
L8=L6-INX 

9 4 VZ  (L,L6,L3, 1)  = VZ (L,L6,L3,1)-VZ(L,L8,L3,1) 

95  CONTINUE 

***  DAMAGE  CALCULATIONS  


WRITE  (6, 375) 

375  FORMAT  (1H0, 31  HPP.EDICTED  THRESHOLD  LASER  POWER) 

DO  104  L=1,LIJ 
I = ID(L) 

J=JD  (L) 

IF  (VZ  (L , INX , NP, 1 ) .LT..001JQD (I,J) =1.E*20 

IF  (VZ  (L,INX,NP,1)  .LT.  .001)  GO  TO  104 

L9  = 1 0 . * ( . 4 + EXP  (- .0014*DPULSE) )/VZ (L,INX,NP, 1) 

CQ=L9* 1 . 

XI 0=70.*  ( . 4 + EXP (-.0014*DPULSE)  )/VZ (L,INX,NP,1) 

IF  (L9 . EQ . 0) CQ=X1 0 
LLT=0 
LGT=0 
99  DAHC=0 . 

L6  = 1 

100  DO  101  L3=1,KX 
X3=0 . 

X50=VZ  (L,L6,L3,1)*CQ+273.+T0 

IF(X50.LT.317.)GO  TO  101 

X1=ZTT  (L^) +DAMAGE  (1,1) -DAMAGE (1 ,2)/X50 

IF (X50 . GT . 323 . ) X1=ZTT (L3) +DAMAGE (2,1) -DAMAGE (2,2) /X 50 

IF  (XI .GT.O.) X3  = 1 .01 

IF  (XI . GT . C . ) GO  TO  101 

X3  = EXP  (XI) 

101  DAMC=DAMC+X3 

IF  (DAMC.GT. 1 .) GO  TO  102 

, C ***  INCREASE  TIME  INDICES  AND  CONTINUE 

i ; L6=L6* 1 

1 IF(L6.LE.INXX)GC  TO  100 

C ***  ADJUST  LASER  POWER  TO  YIELD  THRESHOLD  DAMAGE  AT  GIVEN  POINT 
IF  (LGT.EQ. 1) CQ=1 .02*CQ 
» I IF  (LGT.EQ. 1) GO  TO  103 

LLT  = 1 

J CQ=1 . 04*CQ 
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GO  TO  99 

1 02  IF (LLT.EQ. 1 ) CQ= . 98*CQ 
IF (LLT.EQ. 1) GO  TO  103 
LGT=1 
CQ= . 96*CQ 
GO  TO  99 

103  QD  (I, J) =CQ*POX 
1 C 4 CONTINUE 

WRITE  (6,63)  (R(J)  ,J=1,JB) 

DO  97  I=ID1 ,ID2 
DO  97  J= 1 , JM 
97  XQD(I, J) =QD(I,J) *XXQ 
DO  106  I = ID1 ,ID2 
X1=Z (I) - Z (IPE) +DZ/2. 

IF ( J M . GT . 9) GO  TO  385 

WRITE  (6, 10  5) XI,  (XQD  (I,J)  ,J=1 ,JH) 

GO  TO  106 

38  5 WRITE  (6, 105) XI  , (XQD(I,J)  ,J=1,9) 

WRITE  (6, 105) XI , (XQD  (I , J) ,J=10,JM) 

1C5  FORMAT  (1 H , 2X , 2HZ=, F7 . 5 , 1 X , 3HQD=, 1 P9E1 3 . 6) 

1C6  CONTINUE 

108  IF  (KTYPE.EQ.O)GO  TO  174 

C ***  CALCULATE  AND  STORE  (MULTIPLE  PULSE  EXPOSURE)  TEHPEFATOFES  FOR 
C ***  PLOTTING  PROFILES 
TC=1. /REPET  (LI 3) 

NPL=NPULSE  (LI  3) 

WRITE  (6,139) 

DO  123  L 1 5= 1 , KTYPE 

IF  (TIMEX  (L15) .GT. XT  (KT) ) GO  TO  123 

FG V=0 . 

L2=TIMEX  (L15)/TC 
DTIME  = TIMEX  (L15) -L2*TC 
L2=L2* 1 

DO  116  1=111,112 
DO  116  J=JJ1,JJ2 
X1=0. 

DO  113  L6=1 ,L2 

K = ALOG ( (DTIHE*  (L6-1) *TC) *X60  + 1 . ) /X6 1 ♦ 1 . 

X2=  (DTIME+  (L6-1)*TC-XT(K))/(XT(K*1)-XT(K)  ) 

113  X1  = X1*VC (I,J,K) +X2* (VC  (I,J,K*1) -VC (I,J,K) ) 

V (I,J)=X1 

L3=L2-NPL 

IF (L3.LE.0) GO  TO  115 
X1  = 0. 

DO  114  L6= 1 , L3 

K = ALOG  ( (DTIME*  (L6-1) *TC) +X60* 1 . ) /X6 1+ 1 . 

X2=  (DTIME*  (L6-1) *TC-XT (K) ) /(XT(K+1)  -XT (K)  ) 

114  X1  = X1*VC  (I,J,K)  + X2*  <VC(I,J,K-M)-VC(I,J,K)  ) 

V(I,J)=V(I,J)-X1 

115  IF  (V  (I,J)  .GT. EGV) RGV  = V (I,J) 

1 16  CONTINUE 

SAVRGV  (L  1 5)  =RG V 
IF  (KTYPEO. EQ. 1) GO  TO  121 

WRITE  (7,  117)  NFUN  (LI 3)  ,NPULSE  (LI 3)  , REPET  (1, 13) 

117  FORMAT  (217, E10. 4) 

WRITE  (7,118) XDPULS, NAVEL, RIM 

118  FORMAT  (7E11 .4) 

°P 
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WRITE  (7, 119)111, II2,II3,<JJ1,JJ2 

119  FORMAT  (517) 

WRITE  (7,119) N3,M3 

WRITE  (7, 120)  (R  (J),J=1,N3) 

120  FORMAT  (10F8. 4) 

WRITE  (7, 120)  (Z  (I) ,1=1, M3) 

WRITE  (7, 118)TIHEX(L15) 

121  WRITE  (6, 141) TIMEX (L15) 

WRITE  (6,63)  (R(J)  ,J=JJ1,JJ2) 

JCNT=JJ2-JJ1*1 
IF(JCNT.GT.9)GO  TO  390 

GO  TO  391 

390  JJCNT=JCNT-9 
JJJ2=JJ2-JJCNT 
JJJ2P1=JJJ2+1 

391  DO  122  1=111,112 
X1=Z  (I) -Z  (IPE) +DZ/2 . 

IF  (JCNT. GT. 9) GO  TO  392 

WRITE  (6,64) XI , (V  (I, J)  ,J=JJ1 , JJ2) 

GO  TO  393 

39  2 WRITE  (6,64) XI , (V  (I,J)  ,J=JJ1 ,OJJ2) 

WRITE  (6,64) XI , (V(I,J)  , J=JJJ2P1 , JJ2) 

393  IF (KTYPEO. EQ. 1) GO  TO  122 

WRITE  (7, 137)  (V(I,J)  ,J=JJ1,JJ2) 

122  CONTINOE 

123  CONTINOE 
RG V=0 . 

DO  395  LL 1 5= 1 , KT YPE 

IF  (SAVRGV  (LL1 5) .GT.RGV) RGV  = SAVPGV (LL15) 

395  CONTINUE 
WPITE  (7, 396) 

396  FORMAT  (22HMAX  RGV  CARD(S)  FOLLOW) 

DO  397  LL15=1 , KTYPE 

397  WRITE  (7, 137) RGV 
GO  TO  174 

124  FORMAT  (1 H , 5X , IP 9E1 3 . 6) 

137  FORMAT  (6E13. 6) 

139  FORMAT  (1  HO, 35HTEMPERATURE  RISES  AT  SELECTED  TIMES) 

141  FORMAT(1HO,5X,5HTIME=,E11.4) 

145  IF  (L13.EQ.NTEST) GO  TO  300 
GO  TO  371 

***  DAMAGE  CALCULATIONS  FOR  SINGLE  PULSE 

125  WPITE  (6,126) NRUN  (1)  , XDPULS , N PULSE  (1) 

126  FORMAT(1HO,5X,5HNPUN=,I3,2X,12HPULSE  WIDTH=, E 1 0 . 3 , 2 X , 1 7HNUMBER 
1 PULSES=, 15) 

IF(IFIL.EQO) GO  TC  127 
WRITE  (6,79) RIM, LESION 
GO  TO  128 

127  WPITE  (6,81) RIM, LESION 

128  IF  (IPRT  (6)  .EQ.O) GO  TO  150 
WRITE  (6,375) 

XQ=0. 

DO  138  I=ID1 , IC2 
DO  138  J= 1 , JH 

IF  (VC  (I, J,KH) .IT. .001) QD (I, J)  =1 .0E+20 
IF  (VC  (I,J,KM) . LT ..001) GO  TO  138 
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L9  = 10 .*  {. 4 + EXP  (-.C014*DPULSE) ) /VC (I,J,KB) 

CQ=L9 ♦ 1 . 

XI 0=70.*  (.4*EXP(-.0014*DPULSE) )/VC(I,J,KB) 

IF(L9.EQ.0)CQ=X10 

LLT  = 0 

LGT=0 

131  DABC=0. 

K=2 

132  XI 3 = A LOG (XT  (K)-XT  (K-1) ) 

VPX= (VC (I,J,K) *VC  (I , J, K-  1 ) ) /2 . 

X3=0 . 

X50=VPX*CQ+273.+T0 

IF(X50.LT.317.)GO  TO  134 

X1  = X1 3+DABAGE  (1 , 1) -DAB AGE (1 , 2) /X50 

IF (X50.GT. 323.) X1=X 13* DAMAGE (2, 1) -DAB AGE (2,2)/X50 

IF  (XI .GT.O. ) X3  = 1 .01 

IF (X 1 . GT . 0 . ) GO  TO  134 

X3  = EXP  (XI) 

134  DAHC=DAMC*X3 

IF  (DAHC.GE. 1.) GO  TO  135 
K = K + 1 

IF (K . LT. KT) GO  TO  132 

C ***  ADJUST  LASEP  POWEP  TO  YIELD  THRESHOLD  DABAGE  AT  GIVEN  POINT 
IF  (LGT.EQ. 1 ) CQ= 1 . 02*CQ 
IF (LGT.EQ. 1 ) GO  TO  136 
LLT=1 

CQ= 1 . 04*CQ 
GO  TO  131 

135  IF (LLT.EQ. 1) CQ=. 98*CQ 
IF (LLT.EQ. 1) GO  TO  136 
LGT=  1 

CQ=.96*CQ 
GO  TO  131 

136  QD (I, J) =CQ*POX 
138  CONTINUE 

NRITE  (6,63)  (P (J)  ,J=1,JB) 

DO  140  I=ID1,ID2 
DO  140  J=1,JB 
140  XQD  (I, J) =QD  (I, J) *XXQ 
DO  143  I=ID1,ID2 
X1=Z  (I) -Z  (IPE) + DZ/2 . 

IF ( Jfl . GT. 9) GC  TO  142 

■ RITE  (6, 105) XI  , (XQD(I,J)  ,J=1 ,JBJ 
GO  TO  143 

142  WRITE (6, 105) XI , (XQD (If J)  ,J=1 ,9) 

■ RITE  (6,105) XI  , (XQD  (I, J) ,J=10,JB) 

143  CONTINUE 

150  IF  (KTXPE . EQ . 0) GO  TO  174 

C ***  CALCULATE  AND  STORE  (SINGLE  PULSE  EXPOSURE)  TEMPERATURES  FOR 
C ***  PLOTTING  PROFILES 
WRITE  (6,139) 

DO  170  L15=1 ,KT YPE 
RGV  =0 . 

DTIBE=TIBEX  (L15) 

K=ALOG (DTIBE* (XC- 1 . ) /DTX  + 1 . ) /A LOG  (XC)*1 . 

IF  (K*1 .GT.KT) GO  TO  170 

XI = (DTIHE-XT (K) ) / (XT  (K+- ) - XT  (K) ) 
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DO  166  1=111,112 
DO  166  J=JJ 1 , JJ2 

V (I, J) =VC  (I,J,K) + X1*  (VC(I,J,K+1) -VC (I,J,K)  ) 
IF(V(I,J)  .GT. FGV) RGV  = V (I,J) 

166  CONTINUE 
SAVEGV  (LI  5) =RG  V 
IF(KTYPEO.EQ.1)GO  TO  167 

WRITE (7, 1 17) NRUN  (1)  ,NPULSE(1)  ,FEPET(1) 

WRITE  (7,118) XDPULS, NAVEL, RIM 
NBITE  (7,119) III ,112,113, JJ1.JJ2 
WRITE  (7,119) N3,M3 
WRITE  (7, 120)  (R  (J)  ,J=1,N3) 

WRITE  (7, 120)  (Z (I) ,1=1, M3) 

WRITE  (7,118) TIMEX  (LI 5) 

167  WRITE  (6, 141)TIBEX  (L15) 

WRITE  (6,63)  (R  (J)  ,J=OJ1,JJ2) 

JCNT=JJ2-JJ1+1 

IF (JCNT.GT.9) GO  TO  400 
GO  TO  401 

400  JJCNT=JCNT-9 
JJJ2=JJ2- JJCNT 
JJJ2P1=J JJ2+1 

401  DO  168  1=111,112 

X1  = Z (I)-Z  (IPE) +DZ/2 . 

IF(JCNT.GT.9)GO  TO  402 

WRITE  (6,64) XI,  (V  (I,J)  ,J=JJ1,JJ2) 

GO  TO  403 

402  WRITE  (6,64) XI  , (V  (I,J)  ,J=JJ1 ,JJJ2) 
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WRITE  (6, 64) XI,  (V  (I,J) , J=JJJ2P1 , JJ2) 

403  IF(KTYPEO.EQ.1)GO  TO  168 

WRITE  (7,137)  (V(I,J)  ,J=JJ1,JU2) 

168  CONTINUE 
170  CONTINUE 
RGV=0. 

DO  405  LL1 5=1 , KT YPE 

IF (SAVRGV  (LL15) .GT.RGV) RGV=SAVRGV (LL15) 

405  CONTINUE 
WRITE  (7,396) 

DO  406  LL1 5=1 , KTYPE 

406  WRITE  (7, 137) RGV 

C ***  INTERPOLATE  AXIAL  EXTENT  OF  DAMAGE 

174  15=0 
16=0 

IF(IDl.EQ.ID2)GO  TO  182 
DO  175  I = ID  1 , ID2 
L1=ID1+ID2-I 
IF  (QD  (Li , 1)  . GT . POX) I5=L1 
IF  (QD  (LI , 1)  .LT.POX) I6=L1 
IF  (QD  (1,1) .GT. POX) 17  = 1 
IF  (QD  (1,1)  .LT.POX)  18=1 

175  CONTINUE 

IF  (IPRT  (9)  . EQ. 0) GO  TO  182 
WRITE  (6, 350) 

350  FORMAT ( 1 HO , 22HAXIAL  EXTENT  OF  DAMAGE) 

IF (15 . EQ . 0) WRITE  (6,176) 

176  FORMAT  (1H0,5X,45HDEPTHS  OF  DAMAGE  BEYOND  BOTH  SPECIFIED  DEPTHS) 
IF  (I5.EQ.0) GO  TO  182 
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177 

178 


180 

181 

C *** 
C +** 

182 

360 


183 


185 


187 

188 

189 


190 

191 

192 

200 


C *** 
C *** 

c *** 
c *** 


IF (16 . EQ . 0) GO  TO  190 
IF (15. GE. 16) GO  TO  178 

X2=ALOG(QD (I6,1)/QD (1 5 , 1 ) ) / (Z (16)  -Z (15)  ) 

X1=QD  (15,1) 

X3  = ALOG  (POX/X1) /X2  + Z (15) -Z (IPE)  +DZ/2. 

WRITE  (6, 177) X3 

FORMAT  (1H0,5X,24HMINIHUM  DEPTH  OF  DAMAGE* , El 0 . 3 , 2HCH) 
IF(I8.GE.I7)GO  TO  182 

X2  = ALOG(QD  (18 , 1 ) /QD  (17 , 1 ) ) / (Z (18) -Z (17)  ) 

X1=QD (17 , 1 ) 

X3  = ALOG  (POX/X1) /X2  + Z (17) -Z (IPE) +DZ/2. 

WRITE (6, 181) X3 

FORMAT  (1H0,5X,24HMAXIHUM  DEPTH  OF  DAMAGE* , El 0 . 3 , 2 HCH) 

INTERPOLATE  RADIAL  EXTENT  OF  IRREVERSIBLE  DAMAGE  AT  SPECIFIED 
DEPTHS 

IF  (IPRT  (10)  .EQ.O) GO  TO  192 
WRITE  (6,360) 

FORMAT  (1H0,23HRADIAL  EXTENT  OF  DAMAGE) 

DO  189  I=ID1 ,IP2 
J1=0 

X3  = Z (I) -Z  (IPE) +DZ/2. 

DO  183  J=1,JM 
IF(POX.GT.QD(I,J) )«31=J 
CONTINUE 
X20=0 . 

IF ( J 1 . EQ . 0) GO  TO  187 
IF (J1 .EQ. JH) WRITE  (6,185) X3,R  (JM) 

FORMAT(1HO,5X,2HZ=,E9.3,2HCM , 5X, 36HRADI AL  EXTENT  OF  DAMAGE 
1 THAN,E10.3,2HCM) 

IF (J1 . EQ. JH) GO  TO  189 

X2  = ALOG  (QD  (I,J1+1)/QD(I,J1)  )/(R  (J1*1) -R  (J1)  ) 

X1  = CD  (I, J1) 

X20  = ALOG (POX/X1) /X2  + R (J1) 

WRITE  (6,188) X3,X20 

FORMAT  (1H0,5X,2HZ=,E9. 3,  2HCM,  5X, 37HRADI AL  EXTENT  OF  IRREVERSIBLE 
1AMAGE=,E10. 3 , 2HCM) 

CONTINUE 

IF (LPX. EQ.O) GO  TO  300 
GO  TO  145 
WRITE  (6 , 191) 

FORMAT  (1HO,5X,31HNO  DAMAGE LASER  POWER  TOO  LOW) 

IF  (LPX. EQ.O) GO  TO  300 

GO  TO  145 

STOP 

END 

SUBROUTINE  GRID 

GRID  COMPUTES  THE  COEFFICIENTS  IN  PARTIAL  DIFFERENTIAL  EQUATIONS 
RADIAL  AND  AXIAL  COORDINATES,  R AND  Z,  AND  ASSIGNS  CONDUCTIVITY 
VOLUMETRIC  SPECIFIC  HEAT  TO  GRID 
CALCULATE  B (CM**-2)  AND  R (CM) 

COMMON  A (29,3) ,AAV ,ACH , APE , ASC , ATS , AVL, B (1 4,3) ,BB , BV (1 4 , 3)  , 

1CONX  (6) , CON  (29) ,CUT, DFLOW  (6) ,DPULSE , DR , DT , DTX , DZ , FL , HR (14) , 

2IAB (29,14) , IBLOOD  (10)  ,1 FIL, IGX , IhT , IPA , IPC , IPE, IPROF , IPS , IPT, 
3IPV, IV  (29) ,JVL,LIM,LPA,LPC,LPE,LPS,LPV,LPX,K,KH,KT,M,H1 ,H2, 
4H3,N,N1 ,N3,N4,NVL,POX,PR  (14)  ,PTIHE,QP,R  (14)  , RCO , RIM , RN , RPE ,RRT , 
5RVL , RSC, S (29,14)  ,SHB,TAV ,TCH ,TOM ,TPE ,TVL,TSC,TTS , V (29,14) 
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6 , VC  (29 , 1 4,  1 20)  , VS  H (29)  ,VSHX(6)  , WA VEL , XC , XFLOW , X FLOW! <6) ,X?LOWO(6)  ,PE2007°? 
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7XT  (120) ,Z  (29) ,ZD  (8)  ,ZH,FLOWI  (14)  ,FLOWX (14)  , PUPIL , SIGMA , 

RE200799 

8IPBT  (10) ,APE1,APE2,RINT,ZO, FLO, CABER, CABER2,PP 

PC , NB,  NC,  FC 

FE200800 

DIMENSION  IX  (7) ,LX (7) 

RE200801 

c 

*** 

CALCULATE  B (CH**-2)  AND  R (CM) 

RE200802 

WRITE  (6,170) 

RE200803 

170 

FORMAT  (1  HI ) 

RE200804 

R (1 ) =0  . 

RE200805 

CK=N-N1 

RE200806 

CP=R?L/DR-N1  + 1 . 

RE200807 

XT-2. 

RE200808 

180 

R2  = EXP  (ALOG  (2  .*  (CP* (XI - 1 . ) +1 . ) / (XI  + 1 . ) ) / (CK-1 . 

)) 

RE200809 

IF (R2/X1 .GT. .99999. AND. R2/X1.LT. 1.00001) GO  TO 

181 

RE200810 

X1=R2 

RE20081 1 

GO  TO  180 

RE200812 

181 

IF  (IPRT  (1) . EQ. 0) GO  TO  220 

RE20081 3 

WRITE  (6, 182) 

RE200814 

182 

FORMAT  (1H0, 16HGRID  INFORMATION) 

RE200815 

WRITE  (6 , 1 84) R2 

RE200816 

184 

FORMAT  (1H0,SX,3HR2  = ,F8.4) 

RE200817 

220 

RN=DR*  (N 1 - 1 . ♦ (R2** (CK+ 1 . ) - 1 . ) / (R2- 1 . ) ) 

RE20081 8 

c 

*** 

CALCULATE  RADIAL  SPACE  STEPS  R (J) 

RE20081 9 

DO  185  J=2,N4 

RE200820 

185 

R(J)  = DR*  (J-1) 

RE200821 

X1=R2*DR 

FE200822 

DO  186  J=N4,N 

HE200823 

R (J+1) =R (J) *X1 

BE200824 

186 

X1=R2*X1 

RE200825 

c 

*** 

CALCULATE  COEFFICIENTS  B OF  FINITE  DIFFERENCE 

EQNS. 

RE200826 

X1=2./  (DR*DR) 

RE200827 

DO  187  J=2,N1 

RE200828 

B (J, 1 ) =. 25*  (2*J-3)*X1/(J-1) 

RE200829 

B (J,2) =X1 

RE200830 

187 

B(J,3)=X1-B(J,1) 

RE200831 

X2=DR 

RE200832 

I1=R2*DR 

RE200833 

DO  188  J=N4,N 

RE200834 

B (J,  2)  =2./(X1*X2) 

RE200835 

B (J,  1 ) - (2  . /X2-1 . /F  (J))/(X1*X2) 

RE200836 

B(J,3)  *B  (J,  2)  -B  (J , 1 ) 

RE200837 

X2=R2*X2 

BE200838 

188 

X1=?2*X1 

RE200839 

B(1,1)=0. 

RE200840 

B (1 ,2)  =2./ (DR*DR) 

RE200841 

B (1 , 3) =B  (1 ,2) 

RE200842 

DO  189  J=1 , N 

RE200843 

IF  (R  ( J)  .LT.RVL) JTL=J 

RE200844 

189 

CONTINUE 

RE200845 

c 

• ** 

CALCULATE  AXIAL  SPACE  STEPS  Z(I) 

RE2008U6 

CK=H2“H 1 ♦ 1 

RE200847 

X1*2 . 

RE200848 

190 

CP=2.*TAV/DZ+1.-  (XI** (CK-1.)-1.)/(X1-1.) 

RE200849 

R 1-EXP  (ALOG  (CP*X 1“CP+1 . ) /CK) 

RE200850 

IF  (R1/X1 .GT. .99999. AND. H1/X1.LT. 1.00001) GO  TO 

192 

FE200851 

X1  = R1 

RE200852 

GO  TO  190 

RE200853 

192 

ZM=  ( (R1**CK-1.)/(R1-1.) *M1-1 . ) *DZ 

RE200854 

IF(IPRT(1) .EQ.O)  GO  TO  230 

RE200855 

103 


BRITB(6,194)R1,ZH 

194  FORB AT  (1 H ,5I,3HR1=,F8.4,2X,3HZB=,F8.4) 

230  X1=DZ 

X2  = X1 

DO  195  1=2, H2 
Z (B2*I) =ZB+X2 
Z (B2+2-I) =ZB-X2 
IF(I.GT.BI) X1=R1*X1 

195  X2=X2*X1 
Z (1)=0. 

Z (H2+1) =Zfl 

Z (B+1) =2.*ZB 

X1=Z  (IPE) -DZ/2. -ZD (2) 

DO  196  1=1, B3 

196  Z(I)=Z(I)-X1 
L3=IPA 

DO  200  1=1,7 
LI  =0 

DO  197  I=IPA ,B3 

IF  (Z  (I) .LT.ZD(L+1) )L3=I 

IF(Z  (I) .LT.ZD(L)  . OR . Z (I)  . GE . ZD  (L*1) ) GO  TO  197 
L2  = I 
L 1=L1 + 1 

197  CONTINDE 

IF  (LI .EQ.O) IX  (L) *L3 
IF(L1.SQ.0)LX(L) =13 
IF  (LI .GT.O) IX  (L) =L2*1-L1 
IF  (LI .GT.O) LX  (L) =L2 
200  CONTINDE 
IPV=IX  (4) 

IPC=IX  (5) 

IPS=IX  (6) 

IPT=IX  (7) 

LPA=LX  (1) 

LPE=LX  (3) 

LPT=LX  (4) 

LPC=LX  (5) 

LPS  = LX  (6)  • 

LPT=H3 

c ***  SET  CONDUCTIVITY  CON  AND  HEAT  CAPACITY  YSH  FOR  VARIOUS  EYE  BEDIA 
DO  203  1=1, LPA 
CON  (I) =CONX  (1) 

203  VSH (I) =VSHX  (1) 

DO  204  I=IPE,LPE 
CON  (I) =COHX  (2) 

204  VSH  (I) =VSHX(2) 

DO  205  I=IPV,LPV 
CON  (I) *CONX  (3) 

205  VSH  (I) =VSHX  (3) 

DO  206  I=IPC,LPC 
CON  (I) “CONI  (4) 

206  VSH  (I) =VSHX  (4) 

DO  207  I=IPS,LPS 
CON (I) *CONX (5) 

207  VSH  (I) *VSHX  (5) 

DO  208  I=IPT,H3 
CON  (I)  =CONX  (6) 
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t 


208  VSH(I)=VSHX(6) 

C ***  CALCULATE  COEFFICIENTS  A OF  FINITE  DIFFERENCE  EQNS. 

DO  210  I=IPA,H 
X1  = Z(I*1)-Z(I-1) 

X2=  (CON (1-1) -CON  (I+1))/(X1*I1) 

13=2. *CON (I) /XI 
A(I,1)=X2*X3/(Z(I)-Z(I-1)) 

IF(I.EQ,IPA)A(I,1)=0. 

A (I,  3)  =-X2+X3/  (Z  (1*1)  - Z (I) ) 

210  A(I,2)=A(I,1)+A(I,3) 

RETURN 

END 

SUBROUTINE  INAGE 

C ***  IMAGE  COMPUTES  THE  RETINAL  IRRADIANCE  PROFILE 

COMMON  A (29,3) , A A V , ACH, APE, ASC, ATS , A VL , B (1 4, 3)  , BB , BV  ( 1 4 , 3) , 

1CONX (6) ,CON  (29)  , CUT, DFLOW (6)  , DPULSE, DR , DT , DTX , DZ , FL , HR ( 1 4) , 

2IAB (29,1 4) , IBLOOD  (10) , I FIL , IGX ,IHT , IPA , IPC , IPE, IPROF, IPS , IPT, 

3IPV , I V (29)  ,JVL,LIM,LPA,LPC,LPE,LPS,LPV,LPX,K,KM,KT,H,H1,M2, 
4H3,N,N1,N3,N4,NTL,POX,PR  (14) ,PTIHE,QP,R  (14)  ,RCO , RIM , RN , RPE , RRT, 
5RVL,RSC,S  (29,14)  ,SHB,TAV,TCH ,TOM , TPE ,TVL,TSC, TTS , V (29,14) 

6, VC  (29,14, 120)  , VSH  (29)  ,VSHX(6)  , HA VEL, XC ,XFLON , XFLOWI  (6)  ,XFLONO(6) , 
7 XT  (120) ,Z  (29) ,ZD  (8)  ,ZM,FLOBI (14)  ,FLO»X  (14)  , PUPIL, SIGMA , 

8IPRT  (10) , APB1, APE2,RINT, ZO, FLO, CABER, C ABER2.PP, PC, NB,NC,FC 
DIMENSION  FA  (2001) ,FP (2001) ,FX (2001) ,FY (2001) ,JO (32)  , NA (22) ,PX(30) 
1 , RX  (30) , XF1  (2001) ,XF2 (2001) 

REAL  JO,NA,NB,NC 
DO  200  J=1 , N 

200  PR (J) =0. 

LI=500 

LII=LI 

DO  201  L=1 ,LI 

201  FX (L) =0 . 

READ  (5,202) PUPIL 

202  FORMAT (10E8. 3) 

RINT=PUPIL/  (LI-1) 

IF(IPROF.EQ.1)GO  TO  214 
IF  (IPROF.EQ.O) GO  TO  219 

C ***  INTERPOLATE  IRREGULAR  LASER  PROFILE  (SYMMETRIC  IN  R)  AT  INTERVALS 
C ***  OF  RINT  STARTING  AT  R=0 
READ (5,205) LF 

205  FORMAT (17) 

READ  (5,206)  (RX(L)  ,L=1,LR) 

206  FORMAT ( 1 0E7 . 3) 

READ  (5, 206)  (PX  (L) ,L=1,LR) 

X1  = PX  (1) 

DO  207  L = 1 ,LR 

207  PX  (L) =PX  (L)/X1 
15*0. 

X6=0. 

DO  208  L=2 , LF 

X2=  (PX  (L) -PX  (L-1) )/(RX (L) -RX (L-1) ) 

X1*PX  (L-1) -X2*BX (L-1) 

I3=X1*  (RX  (L) *RX  (L) -RX (L-1) *RX  (L-1 ) ) /2 . 

X4=I2*  (RX  (L) *FX  (L)*RX  (L)-RX  (L-1)*RX (L-1 )*RX (L-1) ) /3. 

IF  (RX  (L) .GT. PUPIL) X6  = I6*6 . 2832* (X3*X4) 

208  X5=I5^6.2832*(X3^X4) 

QP=POX*. 23906* (1 .-RCO)  /X5 
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XX= (X5-X6J/X5  EE200970 

IF  (EX  (LR)  .LT. PUPIL) LI I=RX(LR) /RINT* 1 EE200971 

L2=2  BE200972 

X1=0.  BE2C0973 

DO  213  L= 1 , LII  EE200974 

210  IF (EX  (L2) .GT.X1) GO  TO  212  BE200975 

L2=L2*1  EE200976 

IF (L2.LE.LE)GO  TO  210  EE200977 

GO  TO  213  BE200978 

212  X2= (XI -RX  (L2-1 ) ) / (RX  (L2) -EX  (L2- 1) ) EE200979 

FX (L) =PX (L2-1) +X2*  (PX  (L2) -PX  (L2-1) ) BF200980 

213  X1  = X1  + RINT  RE20098'’ 

GO  TO  223  BE200982 

C ***  CALCULATE  GAUSSIAN  LASER  PBOFILE  AT  INTERVALS  OF  RINT  STARTING  AT  EE200983 

214  SIGMA=RIM*SQRT  (-2./ALOG (CUT)  ) RE200984 

QP=2. * POX* . 23906*  (1 . -BCO) / (3 . 1416*SIGHA*SIGMA)  EE200985 

XX=1 .-EXP  (-2.*P0PIL*PUPIL/(SIGHA*SIGMA) ) BE200986 

IF(IFIL.EQ.I) GO  TO  217  EE200987 

DO  216  J= 1 , N BE200988 

X3  = 2,*E  (J)  *B  (J)  / (SIGMA*SIGHA)  PE200989 

IF(X3.GT.80.)GO  TO  216  RE200990 

PR (J)  =EXP (-X3)  RE200991 

216  CONTINUE  BE200992 

GO  TO  276  EE200993 

217  X1=0.  FE200994 

DO  218  L=1,LII  RE200995 

X3=2.*X1*X1/(SIGHA*SIGHA)  EE200996 

FX (L)  =0 . RE200997 

IF  (X3.GT.80.) GO  TO  218  RE200998 

FX  (L)  =EXP  (-X3)  RE200999 

218  X1=X1 + RINT  RE201000 

GO  TO  227  RE201001 

C ***  SPECIFY  UNIFORM  LASER  PROFILE  FROM  R(1)  TO  E (LIH)  RE201002 

219  QP= POX*. 23906* (1 .-ECO) /(3. 1416*RIM*BIM)  EE201003 

XX=1.  RE201004 

IF (RIM. GT. PUPIL) XX=PUPIL*PUPIL/(RIM*RIH)  BE201005 

IF(IFIL.EQ.1)GO  TO  221  RE201006 

DO  220  J=1 , LIH  RE201007 

220  PE (J) =1 . EE201008 

GO  TO  276  RE201009 

221  L1=RIM/RINT  RE201010 

P INT=R IM/L 1 BE20101 1 

LII=RIH/RINT+1  EE201012 

DO  222  L=1,LII  BE201013 

222  FX  (L) =1 . RE201014 

GO  TO  227  RE201015 

C ***  CALCULATE  TOTAL  AREA  FA (L)  AND  PORTION  OF  LASERS  POWER  BETWEEN  R=0RE201016 

C ***  AND  (L-. 5) *RINT  RE201017 

223  IF (IFIL. EQ. 1) GO  TO  227  RE201018 

FP(1) =3. 1416*FX(1)*RINT*RINT/4.  RE201019 

FA (1) =3. 1416*RINT*RINT/4.  BE201020 

DO  224  L=2,LII  EE201021 

XI = (L- . 5) *RINT  BE201022 

X2= (L- 1 . 5) *RINT  BE201023 

FP (L) =FP  (L-1) *FX  (L) *3. 14  16*  (X1*X 1-X2*X2)  RE201024 

224  FA  (L) =FA  (L-1) *3. 1416*  (X1*Xi-X2*X2)  EE201025 

C ***  CALCULATE  PROFILE  PR (J)  FE201026 


70* 


225 

*** 

227 


228 


230 

231 


234 


X1  = 0. 

X2=0. 

DO  225  J = 1 , N 

X3= (R (J)  + R ( J + 1 ) ) / (2. *RINT) +. 5000001 

IF (X3.LT. 1 • ) X3=1 .000001 

L2=X3 

IF (L2.GE.LII) GO  TO  225 
I4=X3-L2 

X5=FP (L2) + X4*  (FP  (L2+1) -FP  (L2) ) 

X6  = FA (L2) + X4* (FA (12+ 1) -FA (L2)  ) 

PE (J)  = (X5-X1)/  (X6-X2) 

X1  = X5 
X2=X6 
CONTINUE 
GO  TO  276 

SPREAD  FUNCTION  CALCULATIONS 

READ (5,202) ZO , FLO , FC , NB, CABER , PP , PC 

CABER2=CABER/WAVEL 

READ (5,228)  ( JO  (L)  , L= 1 , 32) 

FORMAT  (10F8.5) 

READ (5,228)  (NA  (L) ,L=1,22) 

XI = (WAVEL-350.)/50.+1 . 

L1  = X1 
X2=X1-L1 

NC  = NA (LI) +X2*  (NA  (L1+ 1 ) - NA  (LI ) ) 

X1=(NB-1.)*NC/(NB*  (NC-1.)) 

FL=FLO*X 1 
X2=Z0/FL0 

XO=NC*ZO*X 1/  (NC*X2-X1) -FLO 
X3  = 1 . -PC* (NC*ZO-FC)/(NC*ZO*FC) 

DO  230  L= 1 , LI 
IF (L.GT.LII)GO  TO  230 
X1= (L-1)/X3+1. 000001 
L1=X1 
X2=X 1 -LI 

IF(L1+1.GT.LI)FY(L)=0. 

IF (LI + 1 . GT . LI) LI I=L 
IF(L1+1.GT.LI)GO  TO  230 

FY (L) = (FX (LI) +X2* (FX (L1+1) -FX (LI) ) ) /(X3*X3) 

CONTINUE 
DO  231  L= 1 , LII 
FX  (L)  =FY  (L) 

X5  = ATAN  (PUPIL/ (FLO-PP+XO) ) 

X6=1 .-COS  (X 5 ) 

X7  = SIN  (X 5 ) *SIN  ( X 5) 

FF=FLO-PP 
DO  234  L=1 , LII 
X4= (L-1) *RINT 

XI  =6. 2832*NC* (-FF-X6*X0+SQRT (FF*FF-X7*X0*X0) ) *X4*X4/ (NAVEL* 1 
1PUPIL*PUPIL) 

X2=CABER2*X4*X4*X4*X4 

XF1 (L) =SQRT  (FX (L) )*C0S(X1  + X2) 

XF2 (L) =SQRT  (FX  (L) ) *SIN  (X1+X2) 

DO  260  J=1 , N 

X1=6 . 2832*R  (J) / (NAVEL* 1 . E-7* FF) 

X2=0. 

X3=0. 
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DO  255  L=1 , ill  RE201084 

X4=X1*  (L-1)*RINT  RE201085 

IF  (L.EQ. 1) X4=X1*.25*RINT  RE201086 

IF  (X4 . GT . 3 . ) GO  TO  250  RE201087 

X5=XV.  1*1.000001  RE201088 

LI =X5  RE201 089 

X5=X5-L1  RE201090 

X7=JO  (LI) *X5* (JO (LI  ♦ 1 ) -JO (LI)  ) RE201091 

GO  TO  251  RE201092 

25C  X6=3./X4  RE201093 

X8=. 79788456-. 0000C077*X6- . 00552740*X6*X6- . 00009512*X6*X6*X6+  RE201094 

1 .00137237*X6*X6*X6*X6-.00072805*X6*X6*X6*X6*X6+.00014476*X6*X6*X6*RE201095 
2X6*X6*X6  PE201096 

X9=X4-. 785398 1 6-. 04 166397*X6-. 00003 954*X6*X6+ .00262573*X6*X6*X6-  PE201097 

1 . 0005412  5*X6*X6*X6*X6-. 00029?33*X6*X6*X6*X6*X6+ .0001 3558* X6*X6*X6*PE201 098 
2X6*X6*X6  RE201099 

X7=X8*COS <X9)/SQBT(X4)  RE201100 

IF  (L . GT . 1 ) GO  TO  252  RE201101 

X2=X2+X7*. 25*  (3 . *XF1  (1) *XF1 (2) ) * . 25*RINT* . 5*RINT  RE201102 

X3=X3+X7*. 25*  (3 . *XF2  (1)+XF2 (2) ) *. 25*RINT*. 5*EINT  RE201103 

GO  TO  255  RE201104 

X2=X2  + X7* XF1  (L)*  (L-1)*RINT*RINT  RE201105 

X3=X3+X7*XF2  (L)*  (L-1 ) *RINT*RINT  RE201106 

CONTINUE  RE201107 

HR  (J) =X2*X2+X3*X3  RE201108 

X 1 = HR  (1 ) RE201109 

DO  270  J=1 ,N  RE201110 

HR  (J) =HR  (J)/X1  RE201111 

X1= . 0002  RE201112 

X2=3. 1416*X1*X1/4  RE201113 

J=2  RE201114 

X4  = HR  (1) *X2  RE201115 

L1=2  RE201116 

IF  (XI .LT.R  (J) +.0000001) GO  TO  272  RE201117 

J=J  + 1 RE201118 

GO  TO  271  RE201119 

X5=  (Xl-R  (J-  1 ) )/(R  (J)  -R  (J-1) ) BE201120 

X6  = HR  (J-1) +X5*  (HP  (J) -HR  (J-1) ) RE201121 

X7=8.*  (L1-1)*X2  RE201122 

X4=X4+X6*X7  RE201123 

L1=L1 + 1 RE201124 

X1=Xl+.0002  RE201125 

IF (XI .LE. . 1) GO  TO  271  RE201126 

QP=.23906*XX*POX*  (1.-RCO)/X4  RE201127 

RETURN  F.E201 128 

DO  280  J = 1,N  RE201129 

HR  (J) =PR  (J)  RB201130 

RETURN  RE201131 

END  RE201132 

SUBROUTINE  HTXDEP  RE201133 

HTXDEP  COMPUTES  RATE  OF  HEAT  DEPOSITOR  AT  VARIOUS  POINTS  I,J  RE201134 

COMMON  A (29,3) , AAV , ACH , APE, ASC, ATS , AVL , B (1 4, 3)  , BB  , B V (1 4 , 3) , RE201135 

1CONX  (6) , CON  (29) ,CUT, DFLOW (6)  , DPULSE , DR , DT , DTX , DZ , FL , HR ( 1 «)  , RE201136 

21 AB  (29,14) ,IBLOOD  (10) , I FIL, IGX , IHT, IPA , IPC ,IPE , IPECF, IPS, IPT,  RE201137 

3 IPV , IV  (29)  , JVL,LIM,LPA,LPC,LPE,LPS,LPV,LPX,K,KK,KT,M,H1 ,H2,  RE201138 

4M3,N,N1,N3,N4,NVL,POX,PR(14) , FTIME ,QP ,R (1 4) , PCO , RIM , RN , PPE , RRT,  PE201139 
5RVL, RSC, S (29,14)  , SHB , TA V , TCH , TOM ,TP2 ,T VL,TSC,TTS , V (29,14)  FS201140 


251 


252 

2 55 
260 


270 


271 


272 


276 

280 


C *** 
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6, VC  (29,14, 120) , VSH  (29) ,VSHX(6) , NAVEL , XC , XFLOW , XFLONI (6) ,XFLOWO(6)  ,BE201141 
7 XT  (120)  , Z (29) , ZD  (8)  ,ZH, FLOWI (14) ,FLOWX(14) , PUPIL, SIGHi , BE201142 

8IPBT  (10)  ,APE1,APE2,BINT,ZO,FLO,CABBB,CABEB2,PP,PC,NB,NC,FC  BE201143 

DIMENSION  AB  (29, 3) ,ABB(29,7) ,ABS(7) ,11 (29) ,IZ (29) ,BEF(0)  , BEFL (8)  , BE201144 

1ZH  (29)  BE201145 

IF  (IHT.EQ.O) BETOBN  BE201146 

IF(QP.LT. 1.E-25)GO  TO  340  BE201147 

IF  (IHT.EQ.1) BETDBN  BE201148 

LZ=7  BE201149 

LZ0=LZ-1  PE201150 

LZ1=LZ*1  BE201151 

DO  280  1=1, M BE201152 

II(I)=0  BE201153 

IZ(I)=0  BE201154 

ZH  (I)  = (Z  (I) ♦Z(I*1))/2.  BE201155 

DO  279  L1=1 , 3 BE201156 

279  AB  (I, LI ) =0 . PE201157 

DO  280  Ll=1 ,LZ  BE201158 

280  ABB  (I , LI ) =0 . BE201159 

DO  282  L 1 =1 , LZ  BE201160 

BEF  (L 1 ) =0 . BE201161 

282  BEFL  (LI) =0 . EE201162 

BEF  (2) =BBT  BE201163 

BEF  (6 ) =BSC  BE201164 

BEF  (LZ 1 ) =0 . BE201165 

IF  (IPRT (1) .EQ.O)  GO  TO  350  BE201166 

WHITE  (6, 283)  (ZH  (I) ,1  = 1 , M)  BE201167 

283  FOEHAT  (1H0,5X,3HZH=/(1H  , 5X, 1 0E1 0 . 3) ) HE201168 

C ***  EVALUATE  ABSOBPTION  CONSTANTS  APE1  AND  APE2  FOB  FBONT  AND  BEAB  OF  BE201169 


*** 

PE 

BE201170 

350 

IF  (IGX .EQ. 1 ) GO  TO  284 

BE201171 

APE  1=  (APE-ACH*  (1.-RPE) J/RPE 

EE201172 

APE2=ACB 

EE201173 

GO  TO  285 

BE201174 

284 

APE1 =ACH 

BE201175 

APE2=  (APE-ACH*RPE)/(1.-RPE) 

RE201176 

285 

ABS  (1) =AAV 

BE201177 

ABS  (2) =APE1 

BE201 178 

ABS (3) =APE2 

EE201179 

ABS  (4) =AVL 

BE201180 

ABS (5) = ACH 

EE201181 

ABS  (6) =A SC 

BE201182 

ABS  (7) =ATS 

BE201 183 

L1  = 2 

BE201184 

DO  306  I =IPA , H 

BE201185 

295 

IF  (ZH  (1-1) .LI. ZD (LI)  )GO  TO  296 

BE201186 

L1=L1*1 

BE201187 

GO  TO  295 

BE201 188 

296 

IF(ZH(I)  .GE.ZD  (LI)  )GO  TO  299 

BE201189 

*** 

NO  ZD  BETWEEN  ZH  (1-1)  AND  ZH (I) 

BE201190 

AB  (1, 1)=ABS  (LI-1) * (ZH  (I) -ZH (1-1) ) 

BE201191 

II  (I) =1 

BE201192 

IZ(I) =L1 

BE201193 

IF  (LI . GT . LZ) GO  TO  306 

BE201194 

DO  297  L2=L1,LZ 

BE201195 

297 

ABB  (I,L2) =A6 (1,1) 

BE201196 

GO  TO  306 

BE201197 

299  IP  (ZH  (I)  .GE.ZD  (L1*1) )G0  TO  303 

C ***  ONLY  ZD  (LI)  BETWEEN  ZH(I-I)  AND  ZH  (I) 

AB  (I, 1)=ABS  (LI-1)* (ZD (LI)-ZH (1-1)  ) 

AB(I,2)=ABS(L1)*  (ZH  (I) -ZD  (L**)  ) 

ABB  (I, LI) =AB  (1,1) 

11  (I) =2 
IZ (I) =L1 
L3=LH-1 

IF  (L3.GT.LZ) GO  TO  306 
DO  300  L2=L3 ,LZ 

300  ABR(I,L2)=AB(I,1)*AB(I,2) 

GO  TO  306 

C ***  ZD  (LI)  AND  ZD  (LI +1 ) BETWEEN  ZH(I-I)  AND  ZH  (I) 

3 03  AB(I, 1) =ABS(L1-1)* (ZD (LI)-ZH (1-1)  ) 

AB  (1,2) =ABS  (LI)*  (ZD (L1+1)-ZD (LI)  ) 

AB  (1 , 3) =ABS  (L1  + 1 ) * (ZH (I) -ZD  (LI ♦ 1 ) ) 

ABF  (I, LI) =AB (1,1) 

ABR  (I,L1*1) =AB (1,1) + AB (1,2) 

II(I)=3 
IZ  (I) =L1 
L3=L1 *2 

IF (L3 . GT . LZ) GO  TO  306 
DO  304  L2=L3,LZ 

3 04  ABR (I,L2) =AB  (I, 1) +AB  (1,2) ♦AB  (1,3) 

306  CONTINUE 

DO  314  I=IPA , H 

IF(AB(I,1) .GT.10.)AB(I,1)=10. 

IF (AB (1,2) .GT. 10.) AB  (1,2) =10. 

IF (AB  (1,3) .GT. 10. JAB  (1,3) =10. 

DO  314  L=2 , LZ 

IF (ABR  (I,L) .GT.10.) ABR  (I,L) =10. 

314  CONTINUE 

C ***  DEPOSITION  BY  INCOMING  BEAH 

12  = QP 
L1=2 

DO  317  I=IPA,H 
L2  = II  (I) 

X3=X2 

X2=X2*EXP  (-AB  (1,1) ) 

X4  = 0 . 

IF (L2 . EQ . 1 ) GO  TO  315 
L3=IZ  (I) 

X4=X2*REF  (L3) 

X2=X2*  (1 .-REF  (L3) ) *EXP  (-AB (1,2)  ) 

IF (L2 . EQ. 2) GO  TO  315 
X4=X4-»X2*  REF  (L3+1) 

X2=X2*  (1 .-REF(L3*1) )*EXP  (-AB (1,3) ) 

315  IF (X2 . LT. 1 . E- 10) X2=0 . 

DO  317  J=1 , JVL 

S (I,J)  = (X3-X2-X4)*HR  ( J)  / (ZH  (I) -ZH  (1-1)  ) 

IF  (S  (I,J)  . LT. 1 . E-1 0/DPULSE) S (I , J) =0 . 

317  CONTINUE 

C *=*  CALCULATION  OF  REFLECTED  INTENSITIES  BY  VARIOUS  INTERFACES 
C ***  STARTING  WITH  FIRST  INTERNAL  INTERFACE 
X2=QP 

DO  322  L1=1 ,LZ0 

X3  = A BS  (LI)*  (ZD  (LI ♦!) -ZD (LI)) 
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IF  (X3 . GT . 10 .) X3=1 0 . 

X2=X2*EXP  (-X3) 

REFL (LI ♦ 1 ) =X2*REF (Ll+1) 

322  X2=X2*  <1.-REF(L1+1)) 

DO  327  L1=2,LZ 
I=IPA 

324  IF  (ZH  (I)  .GT.ZD(L1))GO  TO  325 
1=1*1 

IF (I . LE . H) GO  TO  324 
GO  TO  327 

325  X2=BEFL(L1) 

DO  326  L3=IPA,I 
X3=X2 

L4=I+IPA-L3 
X2=X2*EXP  (-ABR (L4,L1)  ) 

DO  326  J=1 , JVL 

S (L4,  J)=S  (L4,  J)  ♦ (X3-X2)  *HR  (J)/(ZH  (L4)  -ZH  (L4-1)  ) 

IF (S  (L4, J) . LT. 1 . E-10/DPULSE) S (L4 , J) =0. 

326  CONTINUE 

327  CONTINUE 
IHT=  1 
RETURN 

C ***  NO  HEAT  DEPOSITION, BEAM  OFF 
340  DO  342  1=1, M3 
DO  342  J=1 ,N3 
342  S(I,J)=0. 

IHT=0 
RETURN 
END 

SUBROUTINE  BLOOD 

SUBROUTINE  BLOOD  COHPOTES  CHANGES  IN  HATRIX  ELEMENTS  A AND  B DOE 
TO  BLOOD  FLON 

COHHON  A (29 , 3)  , AAV , ACH, APE , ASC, ATS , AVL , B (1 4 , 3)  ,BB,BV(14,3)  , 

1 CONX  (6)  , CON  (29) ,CUT, DFLOV (6)  , DPOLSE , DR , DT ,DTX ,DZ, FL ,HR ( 1 4) , 

2IAB (29 , 14) , IBLOOD  (10) , IFIL , IGX , IHT , IPA , IPC , IPE , IPFOF, IPS , IPT , 

3IPV , IV  (29) ,JVL,LIM,LPA,LPC,LPE,LPS,LPV,LPX,K,KM,KT,M,M1 ,N2, 
4H3,N,N1,N3,N4,NVL,POX,PR(14) ,PTIME,QP,K  (14) , RCO, RIB , RN , RPE , RRT, 
5FVL,RSC,S  (29,14)  , SHB,TAV,TCH ,TOK ,TPE ,TVL,TSC,TTS,V  (29,14) 

6, VC  (29,14,120)  ,VSH  (29) ,VSHX(6)  ,HAVEL, XC , XFLOH ,XFLO«I  (6)  ,XFLONO(6) , 
7XT  (120) ,Z  (29) ,ZD  (6)  ,ZM,FLOWI (14)  ,FLOWX  (14)  , PUPIL , SIGMA , 

8IPRT  (10)  , APE1, APE2,RINT,ZO, FLO, CABER, C ABEP2, PP, PC, NB,NC,FC 
DIMENSION  RD  (14)  ,RH  (14)  ,XI  (14)  ,XO  (14) 

C ***  INITIAL  EVALUATION  OF  PARAMETERS  AND  ARRAYS 
DO  800  J=1,N3 
BV  (J, 1) =0. 

BV  (J, 2) =0. 

BV  ( J , 3) =0. 

FLOWI  (J) =0. 

800  FLOWX  (J) =0. 

RH (1) =R (2) /2 . 

DO  803  J=2 , JVL 
803  RH  (J)  = (R  (J)  +R  (J+ 1 ) ) /2. 

L2=2 

DO  810  J=1 , JVL 

805  IF  (DFLOH  (L2) .GT. RH (J) ) GO  TO  806 
L2=L2+ 1 
GO  TO  805 
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806  XI =DFLOH  (L2) -DFLOH  (L2- 1 ) 

X2  = RH  (J) -DFLOH  (L2-1) 

X3=X2/X1 

XX(JJ  = XFLOHI (L2-1)+X3*(XFLOHI (12) - XFLOHI (L2- 1) ) 

810  XO(J)=  XFLOHO(L2-1) + X3* (X FLO BO (L2) - XFLO WO (L2- 1 ) ) 

FLOHX  ( 1)  =0 . 

DO  812  J=2,JVL 

812  FLOHX  (J) =FLOWX  (J-1) + (XI  (J-1) -XO  (J-1 ) ) * (B (J) *R (J) -R (J-1) *B (J-1)  ) / 
1 (2.*TVL) 

FLOHX  (J  VL+- 1 ) =FLOHX  (JVL) 

12=2 

FLOHI  (1) =XFLCHI (1) /TVL 
DO  820  J=2,JVL 

814  IF (DFLOH  (L2) • GT. R ( J) ) GO  TO  816 
L2=L2*1 
GO  TO  814 

816  X4  = DFLOH  (L2) -DFLOH  (L2-1) 

X5  = R (J) -DFLOH  (L2-1 ) 

X6=X6/X4 

820  FLO HI  (J)  = (XFLOHI  (L2-1) +X6*  (XFLOHI  (L2) -XFLOHI (L2-1)) )/TVL 
DO  823  J=2 , JVL 

823  RD  (J)  =1 . / (R  (J)*  (R  (J-M)-R  (J-1)  ) ) 

C ***  CALCULATE  CHANGES  IN  HATRIX  ELEMENTS  A AND  B DUE  TO  BLOOD  FLOH 
BV  (1,1)=0. 

BV  (1,2)  =-SHB*FLOHI(1)/2. 

BV  (1 ,3)=0. 

BB=-SHB+XFLOH/2. 

DO  825  J=2, JVL 
BV  (J,1)=SHB*RD(J)* FLOHX (J) 

BV (J,2) =SHB*RD  (J) * (FLOHX (J-1) -FLOHX  ( J + 1 ) ) /2 . -SHB*FLOHI ( J) /2 . 

825  BV (J,3)=-SHB*RD(J)*FLOHX(J) 

DO  835  I=IPA,B 
835  IV  (I) =0 

DO  840  L3=1 , NVL 
L4  = IBLOOD  (L3) 

840  IV  (L4) =1 

DO  845  I=IPA,LPS 
DO  842  J=1 , JVL 

842  IAB  (I, J) =0 
IF(JVL.EQ.N)  GO  TO  845 
L1=JVL+1 

DO  843  J=L1 , N 

843  IAB  (I, J) =1 
845  CONTINUE 

DO  850  I=IPT,M 
DO  850  J=1,N 
850  IAB  (I , J) =1 
RETURN 
END 
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PLOTTING  ROUTINE  IITBI 
VERSION  14  NOV  1975 
TWO  AND  THREE  DIMENSIONAL  PLOTS 

111,112  I VALDES  DESIGNATING  RANGE  OP  Z (I)  VALDES  POR 

PLOTTING  B ANGE=Z  (III ) TO  Z(II2) 

113  DESIGNATED  PLANE  OR  SORPACE  CORVE  HARKED  WITH 

AN  ASTERISK  SYMBOL 

JJ1,JJ2  J VALDES  DESIGNATING  RANGE  OF  R (J)  VALDES  FOR 

PLOTTING  RANGE=R  (JJ1 ) TO  R (JJ2) 

ORDINATE, CM 

RANGE  OF  R VALDES  TO  BE  PLOTTED, CM 
RANGE  OF  TEMPERATURE  VALDES  TO  BE  PLOTTED, C 
RANGE  OF  Z VALDES  TO  BE  PLOTTED, CM 

TIME  AT  WHICH  TEMPESATDRE  RISE  VALDES  ARE  PLOTTED, 
TEMPERATURE  RISE  AT  TIME  TIMEX  (K)  ,C 
ABSCISSA, CM 


R(J) 

RGR 
RGV 
RGZ 
TIMEX 
V (I,J) 

Z(I) 

REAL  LA 

COMHON/PLBAS1/  P(4,3001) ,ICON  (3001) , NON, NUH AX , IPLTX 
COMHON/PLBAS2/AP (16) ,AV(16) ,CP(16) ,DAT(8) 

DIMENSION  LA (4) 

DIMENSION  RR(100) ,PT(3) ,RP(100) 

DIMENSION  R (14)  ,V  (29,14)  ,Z(29) 

DATA  LA/4 HZ ,CM,4HR,CH,4H  T,C,4HRUN=/ 

IPLTX=0 
5 DAT  (1 ) =1 . 0 
IRR=0 

CALL  SSPLOT 

READ(5,9,END=50) NRDN , NPOLSE , BEPET 
9 FORMAT  (217, E10. 4) 

READ (5,10) D PULSE, WAVEL,RIM 

10  FORMAT(3E11.4) 

READ  (5, 11) III ,112-113, JJ1 ,JJ2 

11  FORMAT  (517) 

READ(5,11) N3,M3 

READ (5, 12)  (R  (J) ,J=1,N3) 

12  FORMAT  (10F8. 4) 

READ  (5, 12)  (Z(I)  ,1=1, M3) 

READ(5,10)TIMEX 
DO  15  1=111,112 
READ  (5, 16)  (V  (I,J)  , J = J J1 , J J2) 

15  CONTINUE 

16  FORMAT (6E13. 6) 

READ (5,16)  RGV 

C ***  START  OF  PROGRAM  FOR  PLOTTING 
RGR=R  (JJ2) -R (JJ1 ) 

RGZ=Z  (112) ~Z (III ) 

SFLAG=0. 

SPAC=0. 

IF(RGV.LT.1.)GO  TO  25 
SFLAG=1. 

IF(  (RGV.GE.12.) -AND.  (RGV . LT. 1 12 . ) ) SFAC=10 . 

IF  ( (RGV. GE. 112.)  .AND.  (RGV.LT. 1120.) ) SFAC=100. 

IF ( (RGV. GE. 1120.) .AND.  (RGV . LT . 1 1 2 00 . ) ) SPAC=1000. 

IF  (RGV. GE.  11200.) SFAC=1 0000. 

IF(SFAC.EQ.O.)GO  TO  26 
DO  14  1=111,112 


PLT00001 
PLT00002 
PLT00003 
PLT00004 
PLT00005 
PLT00006 
PLT00007 
PLT00008 
PLT00009 
PLT00010 
PLT0001 1 
PLT00012 
PLT0001 3 
PLT0001 4 
SECPLT00015 
PLT000 16 
PLT00017 
PLT0001 8 
PLT00019 
PLT00020 
PLT00021 
PLT00022 
PLT00023 
PLT00024 
PLT00025 
PLT00026 
PLT00027 
PLT00028 
PLT00029 
PLT00030 
PLT00031 
PLT00032 
PLT00033 
PLT00034 
PLT00035 
PLT00036 
PLT00037 
PLT00038 
PLT00039 
PLT00040 
PLT00041 
PLT00042 
PLT00043 
PLT00044 
PLT00045 
PLT00046 
PLT00047 
PLT00048 
PLT00049 
PLT00050 
PLT00051 
PLT00052 
PLT00053 
PLT00054 
PLT00055 
PLT00056 
PLT00057 
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DO  13  J=J  J 1 , JJ2 

PLT00058 

13 

V(I,J)=V(I,J)/SFAC 

PLT00059 

14 

CONTINUE 

PLT00060 

RGV=BGV/S  FAC 

PLT00061 

GO  TO  26 

PLT00062 

25 

IF ( (RGV. LT. 1 . ) .AND. (BGV . GE . . 1 ) ) SF AC=1 0 . 

PLT00063 

IF ( (R G V. LT. . 1 ) .AND. (RGV.GS. . 0 1 ) ) SFAC=1 00 . 

PLT00064 

IF( (FGV.LT. .01) .AND.  (RGV .GE. . 001 ) ) SFAC=1000 . 

PLT00065 

IF ( (FGV.LT. .001) .AND.  (BGV.GE. .0001) ) SFAC=10000. 

PLT00066 

IF  (FGV.LT. .0001) SFAC=1 00000. 

PLT00067 

DO  18  1=111,112 

PLT00068 

DO  17  J=JJ1,JJ2 

PLT00069 

17 

V (I,J)=V (I, J) *SFAC 

PLT00070 

18 

CONTINOE 

PLT00071 

RGV=SFAC*RGV 

PLT00072 

26 

HRITE (6, 19) 

PLT00073 

19 

FOE NAT  (1H1 , 3X,21HSCIENTIFIC  INPOT  DATA) 

PLT00074 

HFITE  (6,21) RGZ,FGB,RGV 

PLT00075 

21 

FOENAT  (1H0,4HRGZ=,E8.3,2X,4HFGB=,E8.3,2X,4HRGV=,E8.3) 

FLT00C76 

IF  (SFAC.EQ.O.)GO  TO  28 

PLT00077 

IF  (SFLAG.NE.O.)GO  TO  8 

PLT0007S 

HRITil  (6,7)  SFAC 

PLT00079 

7 

FORMAT  (1H0, 30HTEMPEFATUB E EISES  SCALED  OP  BY,F9.1) 

PLT00080 

GO  TO  28 

PLT00081 

8 

HFITE  (6,27) SFAC 

PLT00082 

27 

FORMAT  (1H0, 32HTEMPEFATOEE  RISES  SCALED  DONS  BY,F9.1) 

PLT00083 

28 

DO  23  1=111,112 

PLT00084 

HFITE  (6,22)  I,  (V  (I , J)  , J=JJ1  , J02) 

PLT00085 

22 

FORMAT  (1  HO, 2HI=, I3/(1X,10P10.5) ) 

PLT00086 

23 

CONTINOE 

PLT00087 

HFITE  (6,24) 

PLT00088 

24 

FORMAT  (1H0,3X,35HAXIS  INFORMATION  (SYSTEM  GENERATED)/) 

PLT00089 

c 

*** 

PLOT  ROUTINE 

PLT00090 

30 

CONTINOE 

PLT00091 

c 

PLT00092 

c 

— 

SET  UP  FOE  PLOT 

PLT00093 

c 

PLT00094 

IDIF=II2-II1+1 

PLT00095 

JDIF=JJ2-JJ1+1 

PLT00096 

NM=  1 

PLT00097 

DO  100  N = 1 , 1 DIF 

PLT00098 

DO  100  N=1 , JDIF 

PLT00099 

1 1 = 11 1 + N-  1 

PLT00100 

J 1 = JJ  1 4-H-  1 

PLT00101 

P (1  , NH) =F  (J1) 

PLT00102 

P (2 , N M)  =Z  (11) 

PLT00103 

P (3,NM)=V  (11, J1) 

PLT001 04 

ICON  (NM) =10 

PLT001C5 

IF(M.NE.I)  ICON (NM) =0 

PLT00106 

NM=NM+ 1 

PLT00107 

100 

CONTINOE 

PLT00108 

DO  200  M= 1 , JDIF 

PLT00109 

DO  200  N=1 , IDIF 

PLT001 10 

J 1=JJ 1 +M-  1 

PLT001 1 1 

1 1 = 11 1 + N-  1 

PLT001 12 

P (1  ,NM)  =F  (J1) 

PLT001 1 3 

P (2  , N M)  =Z  (11) 

PLT00114 

114 

m 

m m 

A 

P(3,Nfl)=V  (11, J1) 

PLT001 1 5 

ICON (Nfl) =10 

PLT001 1 6 

IF(N.NE.I)  ICON  (NH) =0 

PLTOO 1 1 7 

N H=Nfl  + 1 

PLT001 18 

CONTINUE 

PLT00119 

NUHAX=3000 

PLT00120 

NUfl=Nfl-1 

PLT00121 

CALL  POLS UR  (JDIF,IDIF) 

PLT00122 

DO  150  flfl  = 1 , JDIF 

PLT00123 

B= J J1 +BB- 1 

PLT001 24 

NUH=NUfl+1 

PLT00125 

P (1  , NUB)  =E(B) 

PLT00126 

P (2 , NUB) =Z(II1) 

PLT00127 

P (3  , NUB)  =0.0 

PLTC0128 

ICON  (NUB) =10 

PLT00129 

NUB=NUfl+1 

PLT001 30 

P (1 , NUB) =E  (fl) 

PLT00131 

P (2, NUB) =Z  (III) 

PLT00132 

P (3, NUB) =V  (III ,B) 

PLT001 33 

ICON (NUB) =0 

PLT001 34 

CONTINUE 

PLT00135 

DO  160  BB=1 , JDIF 

PLTOO 136 

B=J J1 +BB- 1 

PLT00137 

NUB=NUB+ 1 

PLT00138 

P (1 , NUB)  =R(B) 

PLT001 39 

P (2, NOB) =Z  (112) 

PLTOO 1 40 

P (3, NUB) =0.0 

PLTOO 141 

ICON  (NUB) =10 

PLTOO 142 

NUB=NUB+1 

PLT00143 

P (1 , N UB)  =F  (fl) 

PLTOO 1 44 

P (2, NUB) =Z  (112) 

PLTOO 145 

P (3 , NUB) =V  ( 1 1 2 , B) 

PLT001 46 

ICON  (NUB) =0 

PLTOO 1 47 

CONTINUE 

PLTOO 148 

DO  170  NN=1 ,IDIF 

PLTOO 1 49 

NOB=NUB+ 1 

PLT001 50 

N = NN-fII1-1 

PLT00151 

P (1 , NUB)  =R  (JJ2) 

PLTOO 1 52 

P (2 , NUB) =Z  (N) 

PLTOO 1 53 

P (3, NUB) =0.0 

PLTOO 1 54 

ICON  (NUB) =10 

PLT00155 

NUM=NUB+1 

PLT00156 

P (1, NUB) =R  (JJ2) 

PLT00157 

P (2 , NUB) =Z  (N) 

PLT00158 

P(3,NUB)=V(N,JJ2) 

PLT001 59 

ICON (NUB) =0 

PLTOO 160 

CONTINUE 

PLTOO 1 6 1 

NUB=NUB+ 1 

PLTOO 1 62 

P (1 , NUB)  =R(JJ2) 

PLTOO 163 

P (2, NUB) =Z  (XI 3) 

PLT00164 

P (3, NUB) =V  (113 , J J2) 

PLTOO 165 

P (4, NOB) =11 . 

PLTOO 1 66 

ICON  (NUB) =31 

PLT00167 

NUH=NUB+1 

PLT001 68 

P (1  ,NUB)  =R  (JJ1) 

PLT00169 

P (2, NUB) =Z (III) - RGZ*0 . 25 

PLT0017C 

P (3 , NUB) =RGV*0 . 5 

PLTOO 17 1 

P (4 , NUH) =LA  (3) 

ICON (NUH) =32 
NOH  = N UH* 1 

P ( 1 , NUH) =E (JJ2) *RGB*0 . 1 
P(2,NUH)=Z(II1)*EGZ*0.5 
P (3, NUH) =0.0 
P (4  , NUH)  = LA  (1) 

ICON (NUH) =32 
N0H=NUH* 1 

P (1 , NUH) = R (JJ1) *RGR*0.5 
P (2/ NOH) =Z(II1)-RGZ*0.1 
P (3, NUH) =0.0 
P (4, NUH) =LA  (2) 

ICON (NUH) =32 

CALL  SYHCON  (.07, 4,-1 . 1 ,-1 .2) 

NUH=NUH*1 

P (1 , NUH)  =E  (JJ2) 

P (2,  NUH)  =Z  (III) 

P (3,  NUH)  =0.0 
P (4, NUH) =E  (JJ2) 

ICON (NUH) =33 

C X-AXIS  AT  Y=Z  (III ) 

HP (1 ) =JDIF 
DO  300  KK=1 , JDIF 
IJ=KK*2 
JK= J J 1 +KK- 1 
RP(IJ)=R  (JK) 

IJ=IJ+1 
EP (IJ) =- 1 

300  CONTINUE 
PRINT  398 

398  POEHAT  (1  OX, ' R-AIIS*) 

PRINT  399,  (HP(LL)  ,LL=1,IJ) 

399  FOBHAT (5X.10F10.4) 

PT ( 1 ) =R  ( JJ 1 ) 

PT (2) =Z(II1) 

PT  ( 3)  =0 
LAB  = 1 

CALL  AXES (RP.PT, LAB, 2,1) 

C X-AXIS  AT  Y=Z (112) 

PT(1)=P(JJ1) 

PT (2) =Z  (112) 

PT (3) =0 
LAB  = 1 

CALL  AXES  (RP, PT,LAB, 2 , 2) 

CALL  SYHCON  (0.07, 4, 1.1, -1.2) 

c TAXIS  AT  X=B(JJ1) 

BP ( 1 ) *IDIF 

DO  301  KK=1 , IDIP 

IJ=ICK*2 

JK  = I1 1 *KK- 1 

RP  (IJ) =Z  (JK) 

IJ=IJ*1 
BP  (IJ) *" 1 

301  CONTINUE 
PRINT  397 

397  FOPHAT  (1  OX, * Z-AXIS') 


PLT00172 

PLT00173 

PLT00174 

PLT00175 

PLT00176 

PLT00177 

PLT00178 

PLT00179 

PLT00180 

PLT00181 

PLT00182 

PLT00183 

PLT001 84 

PLT00185 

PLT00186 

PLT00187 

PLT00188 

PLT00189 

PLT00190 

PLT00191 

PLT00192 

PLT001 93 

PLT00194 

PLT001 95 

PLT00196 

PL'.’00197 

PLC00198 

PLr00199 

PLT00200 

PLT00201 

PLT00202 

PLT00203 

PLT00204 

PLT00205 

PLT00206 

PLT00207 

PLT00208 

PLT00209 

PLT0021 0 

PLT0021 1 

PLT0021 2 

PLT0021 3 

PLT00214 

PLT0021 5 

PLT0021 6 

PLT00217 

PLT00218 

PLT00219 

PLT00220 

PLT00221 

PLT00222 

PLT00223 

PLT00224 

PLT00225 

PLT00226 

PLT00227 

PLT00228 
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PRINT  399,  (RP(LL) ,LL*1,IJ) 

PT  (1) =R  (JJ1) 

PT (2) -Z  (III ) 

PT (3) =0 
LAB=2 

CALL  AXES  (RP,PT,LAB,2,2) 

C T- AXIS  AT  TOP  OF  V 

PT  (1)  =R  (JJ1) 

PT (2) *Z(II1) 

PT  (3)  =*R6? 

LAB  = 2 

CALL  AXES  (RP,PT, LAB, 2,1) 

C Y-AXIS  AT  X = R (JJ2) 

PT(1)=R(JJ2) 

PT (2) = Z (III) 

PT (3) =0 
RP (3) *1 
RP(IJ) *1 
LAB=2 

CALL  AXES  (RP,PT, LAB, 2,1) 

c Z-AXIS  AT  X=R  ( J J1 ) , Y=Z  (III ) 

CALL  SYMCON  (0.07, 1,-1. 1,1. 2) 

RP  (1)  =3GV-*-1  . 

RR  (1) =RGV*1 
II  = PF  (1) +1 
DO  302  KK= 1,11 
I J=KK*  2 
RP  (IJ) =KK- 1 
RR  (IJ) =KK- 1 
IJ=IJ+1 

PR(IJ)  = (-1)»‘*  (KK+1 ) 

RP  (IJ) =-1  . 

302  CONTINUE 
PRINT  396 

396  FORMAT  (10X, ' V-AXIS') 

PRINT  399,  (RR  (LL) ,LL=1,IJ) 

PT  (1)  =R  (JJ1) 

PT  (2) =Z  (III) 

PT (3) =0 
LAB  = 3 

CALL  AXES  (RR,PT, LAB, 2,1) 

PT ( 1 ) =R  ( JJ 1 ) 

PT (2)  =Z (1 12) 

PT (3) =0. 

LAE  = 3 

CALL  AXES  (RP,PT, LAB, 2,1) 

PRINT  400 

400  FORMAT  (1H0, 3X,37HTHREE  DIMENSIONAL  POINTS  IN  PLOT  FILE/1H0,6I, 
15HPOINT,23X,1HR,14X,1HZ,14X, 1HV) 

DO  299  LL=1 , NUM 

PRINT  199, LL, ICON  (LL)  ,P(1,LL)  ,P(2,LL)  ,P(3,LL) 

199  FORMAT  (5X , 15, 5X, 15 , 5X , 3F1 5. 4) 

299  CONTINUE 

END  OF  PLOT  SETUP 

WRITE  (6,34) 


PLT00229 
PLT00230 
PLT00231 
PLT00232 
PLT00233 
PLT00234 
PLT00235 
PLT00236 
PLT00237 
PLT00238 
PLT00239 
PLT00240 
PLT00241 
PLT00242 
PLT00243 
PLT00244 
PLT00245 
PLT00246 
PLT00247 
PLT00248 
PLT00249 
PLT00250 
PLT00251 
PLT00252 
PLT00253 
PLT00254 
PLT00255 
PLT00256 
PLT00257 
PLT00258 
PLT00259 
PLT00260 
PLT00261 
PLT00262 
PLT00263 
PLT00264 
PLT00265 
PLT00266 
PLT00267 
PLT00268 
PLT00269 
PLT00270 
PLT00271 
PLT00272 
PLT00273 
PLT00274 
PLT00275 
PLT00276 
PLT00277 
PLT00278 
PLT00279 
PLT00280 
PLT00281 
PLT00282 
PLT0028  3 
PLT00284 
PLT00285 


117 


34  FORMAT  (1H0,3X,43HSUHHARY  OF  ADDITIONAL  SCIENTIFIC  INPUT  DATA) 

WRITE  (6,35) WAVEL , NPULSE 

35  FOFNAT(1HO,11HNAVELENGTH=,E9.4,2HNM,8X,17HNUHBEP  OF  PULSES=,I5) 
WRITE (6, 36) DPOLSE , RIM 

36  FORMAT  (1  HO, 12HPULSE  WIDTH= , E9 . 4 , 3HSEC , 1 0X , 1 3HIHAGE  RADIUS®, E9 . 4 , 
12HCK) 

WRITE (6, 37) REPET 

37  FORMAT  (1  HO , 1 6HPEPETITION  RATE® , E9 .4 , 10HPULSES/SEC) 

WRITE  (6,40) 

40  FORMAT  (1H0, 17HAXIAL  DISTANCE, CM) 

WRITE  (6,41) 

41  FORMAT  (1HC, 18HRADIAL  DISTANCE, CM) 

WRITE  (6,42) 

42  FORMAT  (1H0, 25HTEMPER ATURE  RISE, DEGREE  C) 

WRITE  (6,43)  TIMEX, NRUN 

43  FORMAT (1  HO, 27 HTEMPERATURE  RISE  PROFILE  AT , E9. 4 , 9HSEC  (RUN® , 14 , 1H)  ) 
WRITE  (6,44) 

44  FOP  HAT  (1HO,3X,17HPLOT  COMMAND  LIST/) 

CALL  PLOT  (12. ,-1 1 . ,-3) 

CALL  PLOT  (0 . ,.5,-3) 

HT=. 14 

A=TIMEX 

B=NRUN 

CALL  SYMBOL  (0. , 1. ,HT,29H  TEMPERATURE  RISE  PROFILE  AT  ,C.,29) 
XX=29*HT 

CALL  FNUM  (XX, 1., A, 12) 

XX® XX* 1 6*HT 

CALL  SYMBOL(XX,1.  ,HT,13HSEC  --  RUN  = ,0.0,13) 

XX=XX+13*HT 

CALL  NUMBER  (XX, 1.  ,HT,B, 0.0,0) 

IF(SFAC.EQ.O.)GO  TO  45 
FPN=SFAC 

IF (SFLAG.EQ.0.)FPN=1./SFAC 

CALL  SYMBOL  (0. ,.75,. 1,29H  ORIGINAL  T,C  = PLOTTED  T,C*  ,0.,29) 

CALL  NUMBER  (2.9, .75, . 1 ,FPN,0. ,5) 

45  CALL  READIN  (IRR) 

IF (IRR . EQ . 1 ) GO  TO  50 
GO  TO  5 

50  CALL  PLOT  (12. ,0. ,999) 

STOP 

END 

SUBROUTINE  POLSUR(H,N) 

COHMON/PLBAS1/  P (4,3001) ,ICON  (3001)  , NUN ,NUMAX , IPLTX 
DIMENSION  W (3,500) 

NCT=0 

DO  10  1=1,  N 
DO  10  J=1,M 
NCT=NCT+ 1 
DO  10  L=1 ,3 
W (L,NCT) =P  (L, NCT) 

10  CONTINUE 
NUH  = 0 

DO  20  *1=1, N 
NLO*N 1 
HM=M-1 

DO  20  Ml = 1 , MM 


PLT00286 
PLT00287 
PLT00288 
PLT00289 
PLT00290 
PLT00291 
PLT00292 
PLT00293 
PLT00294 
PLT00295 
PLTQ0296 
PLT00297 
PLT002°8 
PLT00299 
PLT00300 
PLT00301 
PLT00302 
PLT00303 
PLT00304 
PLT00305 
PLT00306 
PLT0030T 
PLT00308 
PLT003C9 
PLT00310 
PLT00311 
PLT00312 
PLT00313 
PLT00314 
PLT0031 5 
PLT0031 6 
PLT00317 
PLT0031 8 
PLT00319 
PLT00320 
PLT00321 
PLT00322 
PLT00323 
PLT00324 
PLT00325 
PLT00326 
PLT00327 
PLT00328 
PLT00329 
PLT00330 
PLT00331 
PLT00332 
PLT00333 
PLT00334 
PLT00335 
PLT00336 
PLT00337 
PLT00338 
PLT00339 
PLT00340 
PLT003U1 
PLT00342 
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BL0=B1 
NUfl  = N UB  + 1 
NA  = B1 

CALL  EQOIV  (P (1 ,NUB)  , H (1  ,NA)  ) 

ICON  (NUB) =0 

IF(BI.EQ.I)  ICON  (NUB) =10 

NUB*NUB+ 1 

NA=  B1 ♦ 1+  (N 1 - 1 ) *B 

CALL  EQU I V (P  ( 1 , NUB)  , W ( 1 , N A) ) 

ICON  (NUB) =0 
NUB=NUB* I 
ISIGN=1 

IF(NI.NE.I)  ISIGN=-1 
NA=HLO+(NLO-1)*B*1 
NB=NA- 1 
NC=NA*ISIGN*fl 

ISIGN=-ISIGN 

CALL  PCPOSS  (H(1,NA) ,H(1,NB)  ,«(1,NC)  ,P(1,NUB) ,ISIGN) 
ICON (NUB) =50 
20  CONTINUE 

DO  30  HI  = 1 , B 
BLO=H 1 
NN=  N-  1 

DO  30  N1 =1 , NN 

NLO=N 1 

NUB  = N UB+ 1 

NA  = B1  + (N1-1) *H 

CALL  EQOIV  (P (1 , NUB)  ,N (1 ,NA) ) 

ICON (NUB) =0 

IF(NI.EQ.I)  ICON  (NUB) =10 

NUH=NUH+ 1 

NA=H1 ♦ (M1-1)*H*B 

CALL  EQUIV  (P(1,NUH)  , W ( 1 , N A)  ) 

ICON  (NUB) =0 
NUH=NUB+ 1 
ISIGN= 1 

IF(BI.EQ.fl)  ISIGN=- 1 
NA=BLO*  (NLO- 1 ) *B  + B 
NB=NA*ISIGN 
NC=NA-H 
ISIGN=-ISIGN 

CALL  PCEOSS  (N  (1  ,NA)  ,W  (1  , NB) , W ( 1 , NC)  ,P(1 ,NUH) ,ISIGN) 
ICON  (NUB) =50 
30  CONTINUE 
RETURN 
END 

SUBROUTINE  PCROSS  (PA , PB , PC, V , IS) 

DIBENSION  PA (3)  ,PB(3) ,PC (3) ,V  (3) 

DIBENSION  VX  (3)  ,VY(3) 

DO  10  1=1,3 
VX (I) =P3 (I) -PA  (I) 

VY (I) =PC (I) -PA  (I) 

10  CONTINUE 

V (1)  = VX  (2)*VY  (3)  - VX  (3)  *VY(2) 

V (2)=-  (VX  (1 ) * VY  (3)-VX  (3)  * V Y (1)  ) 

V (3)  =VX  (1)*VY  (2)  -VX  (2)  *VY  (1) 

SUB  = 0 . 0 
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PLT00352 
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PLT00357 
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PLT00359 

PLT00360 

PLT00361 
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PLT00365 

PLT00366 
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PLT00369 
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PLT00374 
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PLT00376 

FLT00377 

PLT00378 

PLT00379 

PLT00380 

PLT00381 

PLT00382 

PLT00383 

PLT00384 

PLT00385 

PLT00386 

PLT00387 
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PLT00392 
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PLT00394 

PLT00395 
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r 

* 


F 


DO  20  1=1,3 

PLT00400 

20 

SUH=SUN+ V (I) * V (I) 

PLT00401 

SUR=SQHT (SUM) +1 . 0E-20 

PLT00402 

DO  30  1=1,3 

PLT00403 

30 

V (I)  =IS*V (IJ/SUB 

PLT00404 

RETURN 

PLT00405 

END 

PLT00406 

SUBROUTINE  EQUIV(PA,PB) 

PLT00407 

DIHENSION  PA (3) ,PB(3) 

PLT0040e 

DO  10  1=1,3 

PLT004C9 

10 

PA (I) =PB  (I) 

PLT0041C 

RETURN 

PLT0041 1 

END 

PLT0041 2 

SUBROUTINE  S YBCON (HH , NN , XX , Y Y) 

PLT00413 

COBHON/PLBAS1/  P (4,3001)  .ICON (3001)  , NUB , NU B AX , IPLTX 

PLT00414 

NUB=NUB+ 1 

PLT0041 5 

DO  10  1=1,3 

PLT00U16 

10 

P (I, NUB) =0.0 

PLT00417 

P (4, NUB)  =HH 

PLT004 1 8 

ICON (NUB) =71 

PLT0041 9 

NUB=NUN* 1 

PLT00420 

DO  20  1=1,3 

PLT00421 

20 

P (I, NUB)  =0.0 

PLT00422 

P (4, NUB)  =NN 

PLT004 23 

ICON (NUB) =72 

PLT00424 

NUB=NUB*1 

PLT00425 

DO  30  1=1,3 

PLT00426 

30 

P (I, NUB)  =0.0 

PLT00427 

P (4  , NUB)  =XX 

PLT00428 

ICON  (NUB) =73 

PLT00429 

NUB=NUN+ 1 

PLT00430 

DO  40  1=1,3 

PLT00431 

40 

P (I , NUN)  =0.0 

PLT00432 

P (4, NUB) =YY 

PLT00433 

ICON (NUB) =74 

PLTOO  434 

RETURN 

PLT00435 

END 

PLT00436 

SUBROUTINE  READIN  (IRF) 

PLT00437 

COBBON/PLBAS1/  P (4,3C01)  ,ICON  (3001)  , NUB , NUB AX , IPITX 

PLT00438 

COBBON/PLBAS2/  AP (16)  , A V ( 1 6)  ,CP  ( 1 6)  , DAT  (8) 

PLT00439 

COR BON/P LB AS 3/  WINXL, HINYL, WINXW , HINYH , INI N 

PLT00440 

COBBON/PLBAS4/  SCFNXL , SCRNYL, SCRN XW , SCRNYN , ISCRN 

PLT0044 1 

COB BO N/F LB AS 5/  SIGNOR , SNPLOT , IH 

PLT00442 

DIBENSION  NAB  (21) 

PLT00443 

DATA  NAB/  4HP  , 4HINIT, 4HROLL, 4HPITC, 4HYAN  , 

PLT00444 

X 4HSCAL,4HTRAN,4HDIST,4HREIN,4HHIDE, 

PLT00445 

X 4HSIGN,4HNIND,4HSCRN,4HBOX  ,4HEACT, 

PLT00446 

X 4HPLOT,4HUSER,4HPPIN,4HEND  ,4HDUB  , 

PLT00447 

X 4HAXIS  / 

PLT00448 

DATA  NON AB/2 1/ 

PLT0044  9 

EQUIVALENCE  (DAT  (1)  , RDAR  (1) ) 

PLT00450 

DIBENSION  RDAR  (8) 

PLT00451 

DIBENSION  P (4)  ,PSN(3)  ,RBX(3) ,PT(3) 

PLT00452 

IPRIN=0 

PLT00453 

1 

READ (5, 1 0, END=999)  NABR , (PDAP  (L)  ,L=2,8) 

PLT00454 

10 

FOPBAT  (A4,6X,7F10.U) 

PLT00455 

IF  (IPRIN.GT.O)  GO  TO  41 

PLT00456 

120 


40 

41 

C 


20 

C 


50 

30 

100 

111 
1 10 
120 

170 

180 

190 
2 00 
201 

205 


WRITE  (6,4  0)  NAHH,  (RDAR(L)  , L=2 , 6) 

FOB  HAT  (1I,A4,6X,7F10.4) 

CONTINUE 

COMPARE  TO  PBEETOBED  NAMES  IN  ORDER 
DO  20  1=1 , NON AH 
IF(NAHM.EQ.NAM(I) ) GO  TO  30 
CONTINUE 
ERROR  PATH 
IRR  = 1 

WRITE  (6,50) 

FORMAT  (/,  • 

X NAMES  ARE 
GO  TO  999 
CONTINUE 

IF(I.EQ.I)  GO  TO  100 


TO  DETERMINE  THE  ACTION  CODE 


--  INPUT  WORD  HAS  NOT  VALID 
NAHH, NAM 

ERROR  --  THE  CODE  NAME  • , A5, IX, • 
AS  FOLLONS*, /, 20(1X, A4)) 


,99.)  GO  TO  110 


IF  (I.GT. 1 .AND.I.LT. 17)  GO  TO  120 
IK=I- 16 

GOTO  (170, 180, 190,200,210) , IK 
CONTINUE 

IF (RDAR (2) .LT.-0.1.OR.HDAR(2) .GT. 

NUH=NUH+ 1 

DO  111  L= 1 , 4 

P (L , NUM) =RDAR (H-2) 

ICON (NUM) =RD AR  (2) 

GO  TO  1 
CONTINUE 
NUM  = RDAR  (3) 

GO  TO  1 
CONTINUE 
RDAR (1) =1-1 
CALL  SSPLOT 
GO  TO  1 
CONTINUE 
RDAR (1) =17 
CALL  USER 
GO  TO  1 
CONTINUE 
IPRIN  = RDAR  (2) 

GO  TO  1 
CONTINUE 
GO  TO  999 
CONTINUE 

WPITE  (6,201)  NUM , NUMAX 

FORMAT (5X, 'CURRENT  NUMBER  OF  POINTS=  ',16,' 
X , 16) 

NUH1  = HIN0  (NUMAX, NUM) 

IF(NUMI.LF.O)  GO  TO  1 
WRITE  (6,205) 

FORMAT  ( 1 X, 1 OHCOOFDINATE, 10H  LOW  VAL  ,10H 


X 10H  MEAN  VAL  ,10H  WIDTH 
DO  202  J=1 , 3 
RMIN=1 . 0E  + 20 
RMAX=- 1 . 0E+20 
DO  203  L=1 , NUM 
IF(ICON(L) .GE.49)  GO  TO  203 
PMIN  = AMIN1  (RMIN ,P  (J,L) ) 

RMAX  = AMAX  1 (RM AX  , P ( J , L) ) 


) 


PLT00457 
PLT00458 
PLT00459 
PLT00460 
PLT00461 
PLT00462 
PLT00463 
PLT00464 
PLT00465 
PLT00466 

WAS  NOT  VALID,  VALID  PLT00467 

PLT00468 
PLT00469 
PLT00470 
PLT0047 1 
PLT00472 
PLT00473 
PLT00U74 
PLT00475 
PLT00476 
PLT00477 
PLT00478 
PLT00479 
PLT00480 
PLT00481 
PLT00482 
PLT00483 
PLT00464 
PIT00485 
PLT00486 
PLT00467 
PLT0C488 
PLTC0489 
PLT00490 
PLT004S1 
PLT00492 
P1T00493 
PLT00494 
PLT00495 
PLT00496 
PLTC0497 
PLT00498 
PLT00499 

AND  MAXIMUM  ALLOWED3  'PLT005C0 

PLT0050 1 
PLT00502 
PLT00503 
PLT00504 
PLT00505 
PLT00506 
PLT00507 
PLT00508 
PLT00509 
PLT0051 0 
PLTCC51 1 
PLT0051 2 
PLT0051 3 


HI  VAL 
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203  CONTINUE 
RMEAN=  (RBAX+RMIN,  /2.0 
DIF  = B BAX-RMIN 

WRITE  (6,204)  J , RUIN , RM A X, RME AN , DI P 

204  FORMAT  (IX, 'COORD  • , 12 , 1 X , 4F1 0 . 3) 

202  CONTINUE 

GO  TO  1 

210  CONTINUE 
IF(NUB.LE.O)  GO  TO  999 
DO  211  J=1 , 3 
RBIN=1  .OE-i-20 
RBAX=-RBIN 
DO  212  1=1, NUB 
IF  (ICON (I)  .GT. 49)  GO  TO  212 
RMIN= ABIN1  (RBIN , P (J , I) ) 

RBAX  = AMAX1  (RMAX,P(J,I) ) 

212  CONTINUE 
RBX  (J) =RBAX 
RBN  (J) =PBIN 
PT  (J)  = (RBIN  + RBAX)/2.0 
IF  (RDAR  (2)  .GT.0. 1)  PT(J)=RBAX 
IF  (RDAR  (2)  .LT.-0.1)  PT  (J) =RBIN 

211  CONTINUE 
DO  213  J=1 ,3 

IF  (RBX  (J) -RBN  (J)  .IT. 0.0001)  GO  TO  213 
IF  (RBX  (J) -RBN  (J)  .GT.1.0E+20)  GO  TO  213 
R (1)  =RBN (J) 

R (2)  = (RBX (J) -RBN  ( J) ) /5 . 0 
R (3) =6. 0 
R (4) =5.0 
LAb=J 

CALL  AXES  (R,PT,LAB,1) 

213  CONTINUE 
GO  TO  1 

999  CONTINUE 
RETURN 
END 

SUBROUTINE  AXES  (R , PT , LAB, MODE, NCON) 

COBBON/PLBAS1/  P (4,3001) ,ICON (3001)  ,NUB ,NUBAX ,IPLTX 
DIMENSION  R (1) ,T  (102) 

DATA  NT/100/ 

DIMENSION  PT (3) 

DATA  BIG/1. 0E+20/ 

C OBJECTIVE  OF  ROUTINE  IS  TO  GENERATE  AXIS  DATA  IN  THE  THREE 

C DIMENSIONAL  POINT  DATA  BASE 

C INPUT  IS  THRU  CALLING  ARGUMENTS  AS  FOLLOWS 

C LAB  SHOULD  BE  1 2 OR  3 DENOTING  X,  Y OR  Z AXIS  INFORMATION 

C IF  BODE  IS  1 THEN  R(1,2,3  AND  4)  DENOTE  RESPECTIVELY  THE  START, 

C INCREMENT, NUMBER  OF  INCREMENTS  AND  INCREMENT  FOR  NUMBERING 

C MODE=2  BEANS  THAT  THE  TICK  DATA  IS  STORED  IN  THE  ARRAY  R SO  THAT 

C R (1 ) IS  THE  NUMBER  OF  POINTS,  R (2)  IS  THE  VALUE  FOR  THE  FIRST 

C MARK,  R(3)  IS  POSITIVE  IF  A NUMBER  SHOULD  BE  PLOTTED,  AND 

C OTHERWISE  AND  SO  ON 

C IN  THE  CASE  OF  EACH  MODE,  TICK  DATA  IS  BUILT  INTO  THE  LOCAL  ARRAY 

C T AS  A BUFFER,  AND  THEN  TRANSFERRED  TO  THE  POINT  ARRAY 

GO  TO  (10,20) ,MODE 
10  CONTINUE 


PLTG0S14 
PLT0C51 5 
PLT0051 6 
PLTC051 7 
PLTC051 8 
PLT0051 9 
PLT00520 
PLT00521 
PLT00522 
PLT00523 
PLT00524 
PLT00525 
PLT00526 
PLT00527 
PLT00528 
PLT00529 
PLT00530 
PLT00531 
PLT00532 
PLT00533 
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PLT00536 
PLT00537 
PLT00538 
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PLT00550 
PLT00551 
PLT00552 
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NEG ATIVEPLT00565 
PLT00566 


PLT00567 

PLT00568 

PLT00569 

PLT00570 
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STAFT=R(1) 

AINC=R  (2) 

NO  = R (3) 

I VINC=R  (4) 

IRR  = 1 

IP(NO.LE.O)  GO  TO  998 
IFF  = 2 

IF  (HO. GT. NT/2)  GO  TO  998 

T (1) =NO 

SBIN=BIG 

SBAX=-BIG 

DO  11  1=1, NO 

T (2*1) “START* (1-1) *AINC 

T (2*1*1)  =-1 

SBIN=ABIN 1 (T  (2*1)  ,SBIN) 

SBAX=ABAX1  (T  (2*1) ,SBAX) 
IF(ITINC.LE.O)  GO  TO  10 
IF  (BOD  (I,IVINC) . EQ . 1 ) T(2*I*1)=1.0 
11  CONTINDE 
GO  TO  100 

20  CONTINUE 
NO=R  ( 1 ) 

IRR  = 3 

IF(NO.LE.O)  GO  TO  998 
IRF  = 4 

IF (NO. GT. NT/2)  GO  TO  998 

SBIN=BIG 

SBAX=-BIG 

DO  21  1 = 1, NO 

T (2*1) =R  (2*1) 

T (2*1*1) =R  (2*1*1) 

21  CONTINUE 
100  CONTINUE 

JTEB=NUB 
DO  110  1=1, NO 
JTEH=JTEB*1 
DO  120  J=1 , 3 
120  P (J,JTEB) =FT(J) 

P (4, JTEB) =LAB 
P (LAB, JTEB) =T (2*1) 

IF(I.EQ.I)  ICON (JTEB) =NCON*10*1 
IF(I.NE.I)  ICON  (JTEB) =1 
1 10  CONTINUE 
NUB=NUB*NO 
JTEB=NUB 
DO  130  1=1, NO 

IF  (T  (2*1*1) .LT. 0.0)  GO  TO  130 
NUB=N0fl*1 
J1 EB= JTEB* 1 
DO  140  J=1 , 3 
140  P (J, JTEB) =PT ( J) 

P (LAB, JTEB) =T (2*1) 

ICON (JTEB) =33. 

F (4 , JTEB ) =T  (2*1) 

130  CONTINUE 
999  IRP=0 
RETURN 
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c- 

c- 

c- 

c- 

c- 

c- 

c- 

c- 

c- 

c- 

c* 

c- 

c- 

c* 


998  WRITE  (6,997)  IRR  PLT00628 

997  FORMAT  (/,'  ERROF  IB  AXES  ROUTINE,  IRR=  *,I6,/)  PLT00629 

RETURN  PLT00630 

END  PLT00631 

SUBROUTINE  SSPLOT  PIT00632 

COBBON/PLBAS1/  P (4 , 300 1 ) , ICON  (300 1)  , NOB , NUM AX  , IPLTX  PLT00633 

COBMON/PLBAS2/  AP  (1 6) , AV  (1 6)  , CP  (1 6)  , DAT  (8)  PLT00634 

COM BON/PL BAS 3/  U INXL , WINYL, BI NXB , HI  NTH , ININ  PLT00635 

COB HON/PL BA S4/  SCRNXL, SCFN Y L, SCRN XW , SCRN ¥W , SCRNZW , ISCRN  PLT00636 

COBBON/PLBAS5/  SIGNOR , SNPLOT , IH  PLT00637 

COHBON/PLBAS6/DIH AGE , DORIG,DOBX,DOBY  PLT00638 

COBBON/PLBAS7/HT,NDECFX,XLATE,YLATE  PLT00639 

AP , A V ARE  PROJECTIVE  NON  SINGULAR  BATPICES  WHICH  RECORD  THE  PLT00640 

CURRENT  POSITION  OF  THE  POINT  SET  PLT00641 

IH  THE  HIDDEN  LINE  FLAG  PLT00642 

ZVIEW  IS  DISTANCE  OF  VIEWERS  EYE  PROB  PROJECTION  (XY)  PLANE  PLT00643 

DAT  CONTAINS  THE  COBBAND  DATA  FOR  EXECUTING  PIECES  OF  THIS  POUTINEPLT00644 
SIGNOR  THE  SIGN  APPLIED  TO  THE  SURFACE  NOFHALS  PLT0064S 

P CONTAINS  XYZ  DATA  OF  POINTS , VECTORS  AND  SYMBOL  DATA  IN  4TH  PLC  PLT00646 
ICON  CONTAINS  TWO  PACKED  DIGITS  A3  WITH  THE  FOLLOWING  MEANING  PLTC0647 
A=0 , CONTINUE  PRESENT  BODE  OF  PLOTTING,  A=1  START  CONNECTING  POINTSPLT00648 
BY  STRAIGHT  LINES,  A=2  CONNECT  PTS  BY  DASHED  LINES,  A=4  PLOT  POINTPLT00649 


S ONLY,  A=4  PLOT  DASHED  POINTS  PLT00650 

B=0  PLOT  NO  SYBBOL,  B=1  PLOT  CENTERED  SYBBOL  WHOSE  VALUE  IS  P(4,)  PLT00651 

PLOT  LITERAL  STRING  IN  FIELD  P (4 , ) P = 3 PLOT  NUMBER  IN  FIELD  P (4,)  PLT00652 
SET  UP  WINDOW  PARAMETERS  PLT00653 

DATA  SHALL/1. OE-1 0/, SMAL/1 . OE-8/  PLT00654 

DIMENSION  AID  (16)  ,TP  (16) ,BP  (16)  PLT00655 

DIMENSION  RWID (3)  ,RCEN (3)  ,PBIN(3)  , RMAX (3)  PLT00656 

DIMENSION  PP (3) , VV (3)  PLT00657 

DATA  AID/1. 0,4*0. 0,1. 0,4*0. 0,1. 0,4*0. 0,1.0/  PIT00658 

IT=DAT  (1 ) PLT00659 

GO  TO  (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150) , IT  PLT00660 

C IT= 1 INITIALIZE  KEY  VARIABLES  WITH  DEFAULT  VALUES  PLT00661 

10  SIGNOR= 1 . 0 PLT00662 

NUM=0  PLT00663 

IPRIN-0  PLT00664 

HT=0 .07  PLT00665 

SWIDTH=8 . 25  PLT00666 

SHEIGT=6 . 5 PLT00667 

ISCRN=-1  PLT00668 

IWIN=-1  PLT00669 

SCRNXL=0 . 0 PLT00670 

SCRNYL*0 . 0 PLT00671 

SCRNXW=8 . 5 PLT00672 

SCRNYW=6 . 25  PLT00673 

SCRNZW=SCRNXW  PLT00674 

SXUNIT=1 024 . PLT00675 

SYUNIT=760. 0 PLT00676 

IH=0  PLT00677 

ZVIEW=0. 0 PLT00678 

NERASE=0  PLT00679 

NDECFX=~ 1 PLT00680 

XLATE=-1.1  PLT00681 

YLATE=-1 . 1 PLT00682 

IF(IPLTX.GT.O) GO  TO  12  PLT00683 

CALL  PLOTS  (0,0,8)  PLT00684 


12« 


IPLTX=1 

PLT00685 

12  DO  11  1=1,16 

PLT00686 

BP  (I)  = AI D (I) 

PLT00687 

AP  (I)  = AIO  (I) 

PLT00688 

11  AV  (X)  =AID  (I) 

PLT00689 

BP(11) =0.0 

PLT00690 

- REPLACE  INCREMENTAL  VALUES 

WITH  ABSOLUTE  VALUES 

PLT00691 

NUMAX=3000 

PLT00692 

DO  13  L=1 , NUHAX 

PLT00693 

DO  14  K=1 , 4 

PLT00694 

14  P (K , L) =0.0 

PLT00695 

ICON (L) =0 

PLT00696 

13  CONTINUE 

PLT00697 

DOBX=0 . 0 

PLT00698 

DOBY=0 . 0 

PLT00699 

GO  TO  999 

PLT00700 

- 20.30  AND  40  ARE  ROTATION  COMMANDS 

PLT00701 

- IT=2  XYROT  OR  ROLL 

PLT00702 

20  DAT (1 ) =1 . 0 

PLT00703 

CALL  PERSPT  (DAT, TP) 

PLT00704 

CALL  HBULT  (AP,TP,CP,1) 

PLT00705 

CALL  BMULT(AV,TP,CP,1) 

PLT00706 

GO  TO  999 

PLT00707 

- IT=3  YZROT  OF  PITCH 

PLT00708 

30  DAT  (1 ) =2 . 0 

PLT00709 

CALL  PERSPT  (DAT, TP) 

PLT0071 0 

CALL  HBULT  (AP,TP,CP,1) 

PLT0071 1 

CALL  HBULT  (AV, TP, CP, 1) 

PLT00712 

GO  TO  999 

PLT0071 3 

- IT=4  ZXROT  OR  YAW 

PLT0071U 

4C  DAT ( 1 ) =3 

PLT00715 

CALL  PERSPT  (DAT, TP) 

PLT0071 6 

CALL  MHULT  (AP,TP,CP,1) 

PLT00717 

CALL  HBULT  (AV,TP,CP,1) 

PLT0071 8 

GO  TO  999 

PLT00719 

- IT=5  SCALE 

PLT00720 

50  DAT  (1 ) =4 

PLT00721 

CALL  PERSPT  (DAT, TP) 

PLT00722 

CALL  MHULT  (AP, TP, CP, 1) 

PLT00723 

GO  TO  999 

PLT00724 

- IT=6  TRANSLATION 

PLT00725 

60  DAT  ( 1 ) =5 

PLTC0726 

CALL  PERSPT  (DAT, TP) 

PLT00727 

CALL  MHULT  (AP, TP, CP, 1) 

PLT00728 

GO  TO  999 

PLT00729 

- IT=7  SETUP  PROJECTION  ONTO 

XYPLAN  FROM  VIEWERS  POSITION 

PLT00730 

70  DAT  (1 ) =6 

PLT00731 

ZVIEW=DAT  (2) 

PLT00732 

DIB AGE=DAT (2) 

PLT00733 

DOFIG  = DAT  (3) 

PLT00734 

DOBX=DAT (4) 

PLT00735 

DOBY=DAT (5) 

PLT00736 

CALL  PERSPT (DAT, BP) 

PLT00737 

GO  TO  999 

PLT00738 

- REIDENTIFY  THE  TRANSFORMATION  HATRICES 

PLT00739 

80  DO  81  1=1,16 

PLT00740 

AP (I) = AID  (I) 

PLT00741 

125 
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81  AV (I) = AID  (I) 

GO  TO  999 

C SETUP  THE  HIDDEN  LINE  FLAG 

90  IH=DAT (2) 

GO  TO  999 
100  SIGNOR=DAT  (2) 

GO  TO  999 
110  CONTINUE 
IWIN-- 1 

IF(DAT(2)**2  + DAT(3)**2  + DAT(4)**2+DAT(5)**2.LT.SHAL)  GO  TO  999 
IWIN= 1 

HINXL=DAT  (2) 

WINYL  = DAT  (3) 

HINXW=DAT  (4) 

WINYW  = DAT  (5) 

GO  TO  999 

C SCREEN  PARAMETERS  INTRODUCED 

120  CONTINUE 

ISCRN=-ISCRN 

IF  (DAT  (2) **2+DAT  (3) **2+DAT  (4) ** 2 ♦DAT (5) **2 . LT . SMAL)  GOTO  999 
SCRNXL  = DAT  (2) 

SCRNYL  = DAT  (3) 

SCRNXN=DAT  (4) 

SCRNYW  = DAT  (5) 

SCRNZW  = DAT  (6) 

ISCRN=1 
GO  TO  999 

C BOX  COMMAND,  SCALE  THE  OBJECT  TO  PILL  THE  SCREEN 

130  CONTINOE 

IF (ISCRN.LT. 0)  GO  TO  999 
PRO A=DAT (2) 

PPOB=DAT  (3) 

PROC=DAT  (4) 

C DETERMINE  THE  XYZ  EXTENT  OF  THE  TRANSFORMED  OBJECT 

DO  131  L=1 ,3 
RHIN  (L) =1 .0E+2C 

131  RNAX(L)=-1.0E+20 
1=0 

137  1=1+1 

IF(I.GT.NUM)  GO  TO  138 

CALL  DECOD (PP,VV,AA,JCON,ISYH,IVEC,I) 

IF(IVEC.EQ.999)  GO  TO  137 
IF(I.LT.O)  GO  TO  999' 

HH  = PP  (1)*AP(13)+PP(2)*AP(14)+PP(3)*AP(15)+AP(16)  +SMALL 
DO  132  L=1 ,3 
L4  = L*  4 

PPP=  (PP(1)*AP(L4-3)+PP(2)*AP(L4-2)+PP(3)*AP(L4-1)+AP(L4)  )/NN 
RMIN (L) =AHIN1  (PPP, RMIN (L) ) 

EHAX  (L) = AHAX1  (PPP, RMAX  (L) ) 

132  CONTINUE 
GO  TO  137 

138  CONTINUE 

DO  133  L=1 , 3 

FCEN  (L) * (RMIN  (L) +RHAX  (L) ) /2 . 0 
RWID  (L) = RMAX  (L) -RMIN  (L) + SMALL 
DAT  (L+1) =-RCEN  (L) 

133  CONTINUE 


PLT00742 

PLT00743 

PLT00744 

PLT00745 

PLT00746 

PLT00747 

PLT00748 

PLT00749 

PLT00750 

PLT00751 

PLT00752 

PLT00753 

PLT00754 

PLT00755 

PLT00756 

PLT00757 

PLT00758 

PLT00759 

PLT00760 

PLT00761 

PLT00762 

PLT00763 

PLT0076U 

PLT00765 

PLT00766 

PLT00767 

PLT00768 

PLT00769 

PLT00770 

PLT00771 

PLT00772 

PLT00773 

PLT00774 

PLT00775 

PLT0C776 

PLT00777 

PLT00778 

PLT00779 

PLT00780 

PLT00761 

PLT00782 

PLT00783 

PLT00784 

PLT00785 

PLT00786 

PLT00787 

PLT00788 

PLT00789 

PLT00790 

PLT00791 

PLT00792 

PLT00793 

PLT00794 

PLT00795 

PLT00796 

PLT00797 

PLT00798 


IF  (DAT  (4) .LI. 0.0)  CALL  PLOT  (DAT (2) , DAT ( 3)  , 999) 

IF(DAT(4) .LT.0.0)  GO  TO  999 
CALL  PLOT  (DAT  (2)  .DAT  (3)  ,-3) 

151  CONTINUE 

CALL  MMULT  (AP,BP,CP,3) 

--  SETUP  THE  WINDOW .SCREEN  AND  PLOT  BOUNDAFIES 
IF  (ININ. LE.O. AND. ISCBN.LE.O)  GOTO  154 
IF  (ISCRN.GT.O)  GO  TO  153 
IF(IWIN.LE.O)  GO  TO  154 
XL=WINXL 
YL=WINYL 
XW=WINXW 
YW=WIN YW 
GO  TO  152 

153  XL-SCRNXL 
YL=SCRNYL 
XW=SCENXB 
YW=SCBNYW 

152  CONTINUE 

IF  (DAT  (2) **2*DAT  (3) ** 2 . GT. SM AL)  CALL  PLOT (XL+XW/2 . 0 , YL*YW/2 . 0 , 3) 
CALL  PLOT  (XL, YL, 3) 

CALL  PLOT (XL+XN.YL.2) 

CALL  PLOT  (XL*XW,YL*YW,2) 

CALL  PLOT  (XL.YL+YN.2) 

CALL  PLOT  (XL , YL , 2) 

154  CONTINUE 
HOVNOW=0 

IF  (ISCHN. GT.0.OR.IWIN.GT.0)  CALL  WINDOW  (XL, YL , XW ,YW , HOVNOW) 
XLAS=0. 0 
YLAS=0. 0 
IPERH=0 
NPLT=0 
1=0 

301  1=1*1 

IF (I. GT . NUH)  GO  TO  302 
--  MAIN  PLOTTING  LOOP 
X 1 =XLAS 
Y1=YLAS 

--  DECODE  THE  NECESSARY  POINT  AND  AUXILIARY  DATA 
IA  = I 

CALL  DECOD  (PP, VV , AA, JCON, IS YH, IV EC, I A) 

IF (IV EC. EQ. 999)  GO  TO  301 
IF  (IA.LE.O)  GO  TO  300 
I=IA 

IF  (JCON* (5-JCON) . NE.O)  IPBRH=JCON 
IF(IPBRH.EQ.O)  GO  TO  300 

BNOW=PP (1) *CP (13) *PP  (2) *CP  (14) *PP  (3) *CP  (15) +CP  (16) +SHALL 

XNOB= (PP (1 ) *CP (1 ) +PP (2) *CP (2) *PP  (3) *CP (3) *CP (4) ) /WNOW 

YNOW= (PP (1) *CP (5) *PP  (2) *CP (6) *PP (3) *CP (7) *CP (8) ) /NNOW 

X2=XNOW 

Y2-YNOW 

HOVNOW-2 

IF(IWIN.LT.O)  GO  TO  310 
-•  HAKE  THE  REQUIRED  WINDOW  CHECK 
HOVNOW=1 

CALL  WINDOW  (XI, Y 1 ,X2 , Y2 , HOVNOW) 

310  CONTINUE 


PLT00856 
PLT00857 
PLT00858 
PLT00859 
PLT00860 
PLT00861 
PLT00862 
PLT00863 
PLT00864 
PLT00865 
PLT00866 
PLT00867 
PLT00868 
PLT00869 
PLT00870 
PLT00871 
PLT00872 
PLT00873 
PLT00874 
PLT00875 
PLT00876 
PLT00877 
PLT00878 
PLT00879 
PLT00880 
PLT0088 1 
PLT00882 
PLT00883 
PLT00884 
PLT00885 
PLT00886 
PLT00887 
PLT00888 
PLT00889 
PLT00890 
PLT00891 
PLT00892 
PLT00893 
PLT00894 
PLT00895 
PLT00896 
PLT00897 
PLT008S8 
PLT00899 
PLT00900 
PLT00901 
PLT00902 
PLT009C3 
PLT00904 
PLT00905 
PLT00906 
PLT00907 
PLT00908 
PLT00909 
PLT00910 
PLT0091 1 
PLT00912 


IF  (1J0TB0B.lt. 0)  GO  TO  600 
IF(IH.EQ.O.OR.IVEC.LT. 1)  GO  TO  320 

C HAKE  THE  HIDDEN  LINE/SURFACE  NORMAL  CHECK 

VXNOW-VV  (1) *AV  (1) + VV  (2)*AV  (2) ♦?? (3)»AY (3) 

VTIOH*VV  (1) *4?  (5) *VV  (2)* AY  (6) 4V?  (3)*A» (7) 

YZNOW=VV  (1 ) * AV  (9)  ♦ VY(2)*Af  (10)*YV  (3)* A V (11) 

PXNOW  = PP  (1 ) *AP  (1 ) +PP  (2) *AP  (2) *PP  (3) *AP  (3) ♦AP  (4) 

PYNOW=PP  (1) *AP  (5) *PP (2) * AP  (6) *PP (3) *AP (7) *AP (8) 

PZNOB=PP  (1)*AP(9)  ♦PP(2)*AP(10)*PP  (3)*AP  (1 1 ) ♦AP  (12) 

IF  (ABS  (BP  (15) ) .LT. 0.0001)  GO  TO  330 
ZYIEW*-BP  (16) /BP (15) 

D=  (PXNOB-DOBX) * VXNON+  (PYNOW-DOBY) *VYNOW+ (PZNOW-ZVIEW)  * VZNON 
D=D*S IGNOR 
IHCUP*0 
PRINT  311 

311  FORMAT  (•  PXNON , PYNOW, PZNOH, VXNOW , VYNOB , VZNOW , DOBX , DOB Y , Z VI  EH , D' 
WRITE  (6,312)  I, 

X PXNOW,PYNON,PZNOW, VXNOW, VYNOB , VZNOW, DOBX , DOBY , Z VIES , D 

312  FORMAT  (IX, 14, 3 (3  (1X,F9. 3) ) ,2X,F9.3) 

IF (D. GT. 0.0)  IHC0R=1 

GO  TO  340 
330  IHCUR=0 

D-YZNOB* SIGNOR 
IF(D.LT.O.O)  IHCUR= 1 
340  CONTINUE 
320  CONTINUE 

IPERHN  =IPERM 

IF  (IH.EQ.O. OR.IVEC.L1. 1)  GO  TO  350 
IF (IHCUR. EQ. 0)  GO  TO  350 
IF  (IH . EQ . 2)  GO  TO  360 

C TOTALLY  HIDDEN  LINE 

IPERHN=0 
GO  TO  350 
36C  CONTINUE 

IF  (IPEFH.EQ.1)  IPERMN  =2 
IF  (IPERN.EQ.2)  IPERMN  =4 
350  CONTINUE 

IF  (IPERMN  .EQ.O)  GO  TO  600 

IF  ( (IPERNN-2)*  (IPERMN-4)  . EQ . 0 . AND . JCCN . EQ . 0)  GO  TO  370 
NDASH=1 
UX=X2-X1 
OY= Y2-Y1 
GO  TO  380 
370  CONTINUE 

D=SQRT  ( (X2-X1) **2* (Y2-Y1) **2) 

NDASH=D/0 . 25 
NDASH  = MAX0  (3 ,NDASH) 

D1=D/NDASH 

UX=  (X2-X1)/(D+SHALL)*D1 
UY=  ( Y2- Y 1 ) / (C> SMALL) *D1 

C POSITION  POINT  AT  START  OF  SEGMENT 

IF  (MOVNOB. EQ.3.0R.M0VN0B.EQ. 5)  CALL  PLOT  (X 1 , Y1 ,3) 
IF(M0VN0W.EQ.3.0R.M0VN0W.EQ.5)  NPLT=NPLT+1 
360  CONTINUE 

IF (IPERHN  .GT.2)  GO  TO  420 
MODO=-1 

DO  410  J=1,NDASH 


PLT00913 
PLT00914 
PLT0091 5 
PLT00916 
PLT00917 
PLT0091 8 
PLT00919 
PLT00920 
PLT00921 
PLT00922 
PLT00923 
PLT00924 
PLT00925 
PLT00926 
PLT00927 
) PLT00928 

PLT00929 
PLT00930 
PLT00931 
PLT00932 
PLT00933 
PLT00934 
PLT00935 
PLT00926 
PLT00937 
PLT00938 
PLT00939 
PLT00940 
PLT00941 
PLT00942 
PLT00943 
PLT00944 
PLT00945 
PLT00946 
PLT00947 
PLT00948 
PLT00949 
PLT00950 
PLT00951 
PLT00952 
PLT009E3 
PLT00954 
PLT00955 
PLT00956 
PLT00957 
PLT00958 
PLT00959 
PLT00960 
PLT00961 
PLT00962 
PLT00963 
PLT00964 
PLT00965 
PLT00966 
PLT00967 
PLT00968 
PLT00969 


XX=X1*0X*J 

PLT0097C 

yy=yi«-uy*j 

PLT00971 

HODO=-HODO 

PLT00972 

IPIT=2 

PLT00973 

IF (BODO.lt. 0)  IPLT=3 

PLT00974 

IF  (JCON.NE.O)  IPLT=3 

PLT00975 

NPLT=NPLT-*1 

PLT00976 

CALL  PLOT  (XX , YY ,IPLT) 

PLT00977 

«10  CONTINUE 

PLT00S78 

GO  TO  500 

PLT0C979 

420  DO  430  J=1 , NDASH 

PLT0C980 

XX-X1+OX*J 

* 

PLT00981 

YY=Y1+0Y*J 

PLT00982 

CALL  PLOT  (XX, YY, 3) 

PLT00983 

CALL  PLOT (XX, YY , 2) 

PLT00984 

NPLT=NPLT+ 1 

PLT00985 

430  CONTINOE 

PLT00986 

GO  TO  500 

PLT00987 

500  CONTINOE 

PLT00988 

IF (HOVNON.EQ.4.0R.HOVNOW.EQ.5)  GO  TO  590 

PLT00989 

IF  (ISYB.EQ.O)  GO  TO  590 

PLT00990 

GO  TO  (510,520,530) ,ISYH 

PLT0099 1 

510  CONTINOE 

PLT00992 

INT=AA 

PLT00993 

CALL  SYHBOL  (X2 , Y2, HT , INT , 0 . 0 , -2) 

PLT00994 

GO  TO  590 

PLT00995 

520  CONTINOE 

PLT00996 

NCHAR=4 . 0 

PLT00997 

XLEFT= (XL ATE- 1 .0) *0 . 5*NCHAB*HT 

PLT00998 

YLEFT= (YLATE-1 .0) *0 . 5*NCHAR*HT 

PLT00999 

CALL  SYHBOL  ( X2+XLEFT , Y2* YLEFT, HT , AA ,0 . 0 , 4) 

PLT01000 

GO  TO  590 

PLT01001 

530  CONTINOE 

PLT01002 

SZ=2 

PLT01003 

S1XABS  (AA) 

PLT01004 

IF (SI .GT.SHAL)  SZ=ALOG10  (SI) 

PLT01005 

IF  (SI .LT. 0.0001)  GO  TO  591 

PLT01006 

SZ  = ALOG10  (SI) 

PLT01007 

IF(SZ.GE.O.O)  NDEC=1 

PLT01008 

IF(SZ.LT.O.O)  NN=SZ 

PLT01009 

IF (SZ . LT. 0.0)  NDEC=NN+2 

* 

PLT01010 

IF (NDECFX.GE.O)  NDEC=NDECFX 

PLT0101 1 

IF (SZ.GE.0.0)  NSIG*SZ+1 . 0*2 . 0 

PLT01012 

IF(SZ.LT.O.O)  NSIG=NDEC*2 . 0 

PLT01013 

GO  TO  592 

PLT01014 

5S1  CONTINOE 

PLT01015 

NSIG=3 

PLT01016 

NDEC= 1 

PLT01017 

592  CONTINOE 

PLT01018 

IF(AA.LT.O.O)  NSIG=NSIG>1 

PLT01019 

XLEFT=HT*NSIG*  (XLATE-1 . 0) *0.5 

PLT01020 

YLEFT=HT*NSIG* (YLATE-1.0) *0.5 

PLT01021 

CALL  NOHBER  (X2*XLEFT , Y2  + YLEFT ,HT , AA ,0 . 0 , NDEC) 

PLT01022 

590  CONTINOE 

PLT01023 

XLAS=XNOH 

PLT01024 

YLAS=YNOM 

PLT01025 

GO  TO  300 

PLT01026 

130 
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3 CONTINUE  PLT01027 

D CONTINUE  PLT01028 

GO  TO  301  PLT01029 

2 CONTINUE  PLT01030 

WRITE  (6, 390)  NPLT  PLT01031 

) FOR HAT  (6X,  ' PLOT  COMPLETED,  TOTAL  POINTS  PLOTTED*  *,I6)  PLT01032 

GO  TO  999  PLT01033 

3 RETURN  PLT01034 

END  PLT01035 

SUBROUTINE  N INDOW  (X A, Y A, XB, YB , HOD)  PLT0103C 

ROUTINE  TO  EXAMINE  THE  CURRENT  SEGMENT  RELATIVE  TO  THE  CURRENT  PLT01037 
NINDON  PLT01036 

INPUT  IF  MOD  IS  0 THEN  XA,YA  ARE  LONER  LEFT  CORNER  OF  NEW  NINDON  PLT01039 

AND  XB  AND  YB  ARE  THE  WIDTH  AND  HEIGHT  OF  THE  WINDOW  PLT01040 

OTHER  PARAMETERS  APE  ALSO  INITIALIZED  IN  THIS  CASE  PLT01041 

THE  RETURN  VALUE  OF  MOD  IS  -1  PLT01042 

IF  MOD  IS  1 THEN  XA,YA  AND  XB , YB  REPRESENT  END  POINTS  OF  A LINE  PLT01043 
SEGMENT  WHICH  SHOULD  BE  WINDOWED.  IF  HOD=-1  ON  PETURN  THE  SEGMENT  PLT01044 
DOES  NOT  INTERSECT  THE  WINDOW,  IF  MOD=2  THE  INTERSECTION  OCCURS  PLT01045 

AND  THE  FIRST  POINT  DOES  NOT  CHANGE,  WHILE  IF  MOD=3  THE  FIRST  P PLT01046 
HAS  CHANGED.  XA,YA,XB,YB  HAY  BE  MODIFIED  ON  OUTPUT  TO  HOLD  PLT01047 

CHANGED  VALUES  OF  THE  END  POINTS  PLT01048 

IF  HOD  IS  LESS  THAN  -1,  AN  ERROR  HAS  OCCURRED  PLT01049 

DIMENSION  PX(2)  ,PY  (2)  , PD  (5)  , X (5)  , Y (5) , I ND  (2, 2)  PLT01050 

DATA  IND/1 ,2,4,3/  PLT01051 

DATA  SMAL/1 .0E-20/  PLT01052 

LOGICAL  AIN, BIN  PLT01053 

BET  (A,B,C)  = (B-A) * (C-B)  PLT01054 

IF  (MOD) 20, 10,20  PLT01055 

INITIALIZATION  OF  WINDOW  PARAMETERS  PLT01056 

) CONTINUE  PLT01057 

XL=XA  PLT01058 

YL=YA  PLT01059 

XW=XB  PLT01060 

YW=YB  PLT01061 

XU=XL*XW  PLT01062 

YU*YL*YW  PLT01063 

X ( 1 ) =XL  PLT01064 

X (2) =XL+XW  PLT01065 

X (3) =X  (2)  PLT01066 

X (4) =XL  PLT01067 

X (5) =XL  PLT01068 

Y (1 ) =YL  PLT01069 

Y (2) =YL  PLT01070 

Y(3)=YL+YW  PLT01071 

Y(4)=Y{3)  PLT01072 

Y (5) *YL  PLT01073 

HXW=XW/2. 0 PLT01074 

HYW  = Y W/2 . 0 PLT01075 

XC=XL* HXW  PLT01076 


•4 

YC=YL+HYW 

PLT01077 

: i 

DC=HXW*HXW-fHYW*HYW 

PLT01078 

Mi  \ 

MOD*- 1 

PLT01079 

f * * 

GO  TO  999 

PLT01080 

f . 

C BEGIN  WINDOW  CUTTING  ACTION  ON  SEGMENT 

PLT01081 

* ■ 

20  CONTINUE 

PLT01082 

‘K 

AX=BET  (XL , X A , XU) 

PLT01083 

131 
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' ' t! 

* 

- - A 

AY=BET  (YL , YA , YU) 

PLT01084 

AIN= . TRUE . 

PLT01085 

IP  (AX. LT. 0.0. OP.AY.LT. 0.0)  AIN=. FALSE. 

PLT01086 

BX=BET  (XL,XB,XU) 

PLT01087 

BY  = BET  (YL,YB, YU) 

PLT01088 

BIN  = . TRUE . 

PLT01089 

IF  (BX.LT. 0.0. OR.BY.LT. 0.0)  BIN=. F ALSE. 

PLT01090 

IF  (AIN. AND. BIN)  GO  TO  100 

PLT01091 

IF  (AIN  . OR . BIN)  GO  TO  200 

PLT01092 

GO  TO  300 

PLT01093 

— 

BOTH  INSIDE 

PLT01094 

IOC 

CONTINUE 

PLT01095 

MOD  = 2 

PLT01096 

GO  TO  999 

PLT01097 

— 

ONE  INSIDE/  ONE  OUTSIDE 

PLT01098 

200 

CONTINUE 

PLT01099 

IF  (AIN)  GO  TO  210 

PLT01100 

XX=X  A 

PLT01101 

YY  = YA 

PLT01102 

GO  TO  220 

PLT01103 

2 1 C 

XX=XB 

PLT01 104 

YY  = YB 

PLT011C5 

220 

CONTINUE 

PLT011C6 

— 

CHOOSE  THE  MAIN  CORNER  REFERENCE  POINT 

PLT01107 

SX=XX-XC 

PLT01108 

SY=YY-YC 

PLT01109 

1 = 2 

PLT01110 

J=2 

PLT01111 

IF(SX.LT.O.O)  1=1 

PLT01112 

IF(SY.LT.O.O)  J=1 

PLT01113 

IS=IND  (I, J) 

PLT01114 



SET  UP  THE  EON  OF  THE  LINE  SEGMENT 

PLT01115 

A=YB-YA 

PLT01116 

B=XA-XB 

PLT01117 

C=XB*YA-XA*YB 

PLT01118 

ISA=IS-1 

PLT01119 

IF  (ISA.LT. 1)  ISA=4 

PLT01120 

D1=A*X(IS)+B*Y(IS)+C 

PLT01121 

D2  = A*X  (ISA) *B*Y  (ISA) *C 

PLT01122 

IF  (D1*D2.GT.0.0)  ISA=IS* 1 

PLT01123 

IF  (IS A . GT .4)  ISA  = 1 

PLT01124 

ICUM=ISA+IS 

PLT01125 

IF  (ICUM.NE.5)  GO  TO  240 

PLT01126 

XX  = X (IS) 

PLT01127 

YY=-  (C*A*X (IS) ) / (B+SHAL) 

PLT01128 

GO  TO  250 

PLT01129 

240 

XX=-  (C*B*Y (IS) ) / (A+SHAL) 

PLT01 130 

YY  = Y (IS) 

PLT01131 

250 

CONTINUE 

PLT01132 

IF  (AIN)  GO  TO  260 

PLT01133 

XA  = XX 

PLT01134 

YA=YY 

PLT01135 

HOD=3 

PLT01136 

GO  TO  999 

PLT01137 

260 

CONTINUE 

PLT01138 

XB=XX 

PLT01139 

YB=YY 

PLT01140 

132 


w 


H0D=4 
GO  TO  999 

C THE  CASE  OF  TWO  POINTS  OUTSIDE  THE  WINDOW 

300  CONTINUE 

IF(XA-XL.LT.0.0. AND . XB-XL . LT . 0 . 0)  GO  TO  390 

IF (XA-XU.GT.0.0. AND.XB-XU.GT.0.0)  GO  TO  390 

IF(YA-YL.LT.C.O. AND . YB- YL. LT . 0 . 0)  GO  TO  390 

IF(YA-YU.GT.0.0.AND. YB-YU.GT.0.0)  GO  TO  390 

A=YB- YA 

B=XA-XB 

C=XB*YA-XA=YB 

ICUH=0 

PD (1)  = A*X  (1) *B*Y  (1) +C 
DO  310  1=2,5 
PD  (I)  = A*X  (I)  +B+Y  (I)  +C 
IF (PD  (I) *PD  (1-1)  .LT. 0.0)  ICUH=ICUH+1 
310  CONTINUE 

IF(ICUH.EQ.O)  GO  TO  390 
NUH  = 0 

DO  340  1=1,4 

IF  (PD  (I) *PD  (1  + 1)  .GT.0.0)  GO  TO  340 
NUH=NUH+ 1 

IF  (NUB. Gl. 2)  GO  TO  340 
ICUH=I+I* 1 

IF  (ICUB.EQ.3.0P.ICUB.ECI.7)  GO  TO  350 
PY (NUB) =-  (C  + A*X (I) ) / (B+SHAL) 

PX  (NUB) =X  (I) 

GO  TO  340 

350  PX (NUB)=-  (C+B*Y  (I) )/(A+SHAL) 

PY  (NUB) = Y (I) 

340  CONTINUE 

IF (NUN .LT . 2)  GO  TO  998 
D1= (PX  (1) -XA) **2+  (PY  (1 ) - YA) **2 
D2=(PX(2)-XA)**2+  (PY  (2) -YA)**2 
NUB  1 = 1 

IF  (D2.LT.D1)  NUB  1 =2 
XA  = PX  (NUB  1 ) 

YA=PY  (NUB1 ) 

NUB2=2 

IF  (NUB1 . EQ. 2)  NUB2  = 1 
XB=PX  (NUB2) 

YB=PY ( NUB2) 

BOD  = 5 
GO  TO  999 
390  CONTINUE 
HOD=- 1 

999  CONTINUE 
EETUEN 
998  NOD=-2 

GO  TO  999 
END 

SUBEOUTINE  CECOD  (PP , VV , AA , JCON , IS YB , IVEC,I) 
COHHON/PLBAS 1/  P (4,3001) ,ICON  (30C1)  , NUB , NUBAX , IPLTX 
COKBON/PLBAS2/  AP  (16) , AV  (1 6) ,CP  (1 6) ,DAT  (8) 
COHHON/PLBAS 3/  WINXL, WINYL, WINXW , WINYW,IWIN 
COB HON/PL BAS4/  SCENXL, SCEN YL , SCENXW , SCENYW , ISCEN 
COHHON/PLBAS 5/  SIGNOB , SNPLOT , IH 
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PLT01 141 
PLT01 142 
PLT01143 
PLT01144 
PLT01 145 
PLT01146 
PLT01 147 
PLT01148 
PLT01 149 
PLT01 150 
PLT01151 
PLT01 152 
PLT01153 
PLT01154 
PLT01 155 
PLT01156 
PLT01 157 
PLT01158 
PLT01 159 
PLT01 160 
PLT01 161 
PLT01162 
PLT01163 
PLT01164 
PLT01165 
PLT01166 
PLT01167 
PLT01 168 
PLT01 169 
PLT01 170 
PLT01 171 
PLT01172 
PLT01173 
PLT01174 
PLT01175 
PLT01176 
PLT01 177 
PLT01178 
PLT01179 
PLT01 180 
PLT01 181 
PLT01ie2 
PLT01183 
PLT01184 
PLT01 185 
PLT01186 
PLT01187 
PLT01 188 
PLT01189 
PLT01 190 
PLT01191 
PLT01 192 
PLT01193 
PLT01 1S4 
PLT01 195 
PLT01196 
PLT01197 


COHMON/PLBAS7/HT ,NDECFX , XLATE, YLATE 

PLT01 188 

DIMENSION  PP ( 3)  ,VV  (3) 

PLT01 199 

IVEC=0 

PLT01200 

IF(I.GE.NUMAX)  GO  TO  999 

PLT01 201 

IF(I.GT.NUM)  GO  TO  999 

PLT01202 

DO  10  L=1 , 3 

PLT01203 

10 

PP  (L)  =P (L , I) 

PLT01204 

AA  = P (4,1) 

PLT01205 

JCON=ICON  (I)/10 

PLTC1206 

ISYM  = ICON  (I)-10*JCON 

PLT01 207 

IF  (JCON.GE. 5)  GO  TO  997 

PLT01208 

IF  (ISYM.GT. 3)  GO  TO  999 

PLT01209 

INEX=ICON (I  + 1J/10 

PLT0121C 

IVEC=0 

PLT01211 

I F (INEX . NE . 5)  GO  TO  998 

PLT01212 

1 = 1 + 1 

PLT01213 

DO  20  L=1 , 3 

PLT01214 

20 

VV  (L)  =P  (L, I) 

PLT01 21 5 

IVEC= 1 

PLT0121 6 

998 

CONTINUE 

PLT01217 

RETURN 

PLT01218 

999 

CONTINUE 

PLT01219 

I=-1 

PLT01220 

RETUPN 

PLT01221 

9 97 

CONTINUE 

PLT01222 

IVEC=999 

PLT01223 

IF  ( JCON. NE. 7)  RETURN 

PLT01224 

IF(ISYM.EQ.I)  HT=P  (4 , I) 

PLT01225 

IF  (ISYM. EQ . 2)  NDECFX=P (4 , 1) 

PLT01226 

IF  (ISYM. EQ. 3)  XLATE=P (4,1) 

PLT01227 

IF  (IS YB . EQ . 4)  YLATE=P (4,1) 

PLT01228 

RETURN 

PLT01229 

END 

PLT01230 

SUBROUTINE  BHULT  (A ,B,C, M) 

PLT01231 

--  CONSTRUCT  C=A*B  AND  STORE  THE  RESULT  IN  A OR  B 

PLT01232 

DIMENSION  A (16) , B (16) ,C (16) 

PLT01233 

DIMENSION  ITEHP  (4) 

PLT01234 

DATA  ITEHP/ 1,5, 9, 13/ 

PLT01235 

DO  10  IROW= 1,4 

PLT01236 

DO  10  ICOL= 1,4 

PLT01237 

KK=ITEHP (ICOL) 

PLT01238 

SUM=0 . 0 

PLT01239 

DO  11  K= 1 , 4 

PLT01240 

SUM  = SUH  + A (IROS+K*4-4)*B (KK+K-1) 

PLT01241 

11 

CONTINUE 

PLI01242 

C (4*ICOL-4+IROW)  =SUH 

PLT01243 

10 

CONTINUE 

PLT01244 

IDEBUG=0 

PLT01245 

IF  (IDEBUG.EQ.O)  GO  TO  20 

PLT01246 

WRITE  (6,50) 

PLT01247 

50 

FORMAT (//) 

PLT01248 

DO  30  1=1,4 

PLT01249 

IL=I+1 2 

PLT01250 

WRITE  (6,40)  (A  (L)  ,L=I,IL,4) , (B (L)  ,L=I,IL,4) , (C (L)  ,L=I,IL,4) 

PLT01251 

40 

FORMAT  (•  MMULT',4  (1X,F8.3) ,3X,4 (1X,F8.3) ,3X,4 (1X,F8.3)  1 

PLT01252 

30 

CONTINUE  ' 

PLT01253 

20 

CONTINUE 

PLT01254 

1?* 


u o 


IF  (N . EQ . 3 ) RETURN 

PLT01255 

DO  12  1=1,16 

PLT01256 

IF(M.EQ.I)  A (I) =C  (I) 

PLT01257 

IF (M. EQ. 2)  B (I ) =C  (I) 

PLT01258 

12 

CONTINUE 

FLT01259 

BETUBN 

PLT01260 

END 

PLT01261 

SUBBOUTINE  PERSPT (DAT, B) 

PLT01262 

- ( 

GENERATE  A PROJECTIVE  MATRIX  B FROM  A SIMPLE  COMMAND  DAT 

PLT01263 

DIMENSION  DAT  (1)  ,B(1)  ,AID(16) 

PLT01264 

DATA  AID/1. 0,4* 0.0, 1.0, 4* 0.0, 1.0, 4* 0.0, 1.0/ 

PLT01265 

DATA  CDB/0. 01745329251994/ 

P1T01266 

- 

DAT  (1 ) CONTAINS  THE  COMMAND  FLAG  =1  = XYBOT,  2 = YZFOT, 

PLT01267 

- 

3=ZXROT,  4= VABI ABLE  SCALE,  5=TBANS,  6=CENTEB 

PLT01268 

DO  10  1=1,16 

PLT01269 

10 

B (I)  =AID  (I) 

PLT01270 

IFL AG  = DAT  (1) 

PLT01271 

IF  (IFLAG.GT.3)  GO  TO  50 

PLT01272 

A=DAT  (2) *CDR 

PLT01273 

C=COS  (A) 

PLT01274 

S = SIN  (A) 

PLT01275 

GO  TO  (20,30,40) , IFLAG 

PLT01276 

20 

B(1)=C 

PLT01277 

B (2)  =-S 

PLT01278 

B (5) =S 

PLT01279 

B (6) =C 

PLT01280 

GO  TO  100 

PLT01281 

30 

B (6) =C 

PLT01282 

B(7)=-S 

PLT01283 

B (10) =S 

PLT01264 

B(11)=C 

PLT01285 

GO  TO  100 

PLT01286 

40 

B(1)=C 

PLT01287 

B (3) =S 

PLT01288 

B (9) =-S 

PLT01289 

B ( 1 1 ) =C 

PLT01290 

GO  TO  100 

PLT01291 

50 

IFLAG=IFLAG-3 

PLT01292 

GO  TO  (60,70,80)  , IFLAG 

PLT01293 

60 

W = DAT  (3)**2+DAT(4)**2 

PLT01294 

IF  (W.LT. 0.000001)  GO  TO  65 

PLT01295 

B (1)  =DAT  (2) 

PLT01296 

B(6)=DAT  (3) 

PLT01297 

B (11) =DAT  (4) 

PLT01298 

GO  TO  100 

PLT01299 

65 

B (1)  =DAT  (2) 

PLT01300 

B (6)  =DAT  (2) 

PLT01301 

B (1 1)  =DAT (2) 

PLT01 302 

GO  TO  100 

PLT013C3 

70 

B (4)  =DAT  (2) 

PLT0130- 

B (8)  =DAT (3) 

PLT01305 

B (12)  =DAT (4) 

PLT01306 

GO  TO  100 

PLT01307 

60 

D=ABS  (DAT  (2) ) 

PLT01308 

B (11) =0.0 

PLT01309 

IF  (D.GT. 0.0001)  B (1 5) =- 1 ./DAT (2) 

PLT01310 

D1  = ABS  (DAT  (3) ) 

PLT01311 

135 


IF (D1 .GT. 0.0001 .AND. D.GT.O. 0001)  B ( 1 6) = DAT (3) /DAT (2) 
B (4) =-DAT  (4) 

B (8) =-DAT  (5) 

100  CONTINUE 
IDEBUG=0 

IP (IDEBUG. EQ.O)  EETUEN 
WHITE  (6,140) 

140  FORHAT (//) 

DO  110  1=1,4 
IL=I+1 2 

WRITE  (6, 120)  (B ( J) , J=I , 11,4) 

120  POEHAT (10X, 'PEESPT' ,4  (2X,F12. 5) ) 

1 10  CONTINUE 
RETURN 
END 

SUBROUTINE  USEE 

COHHON/PLBAS1/  P (4,3001) ,ICON  (3001)  ,NUH  ,NUMAX,IPLTX 
COMHON/PLBAS2/  AP  (16) , AV  (16) ,CP  (16) ,DAT  (8) 

COH HO N/PLBAS3/  WINXL , WINYL, WINXW , WINYW, IBIN 

COHHON/PLBAS4/  SCENXL, SCBNYL, SCRNXW , SCRNYW ,ISCEN 

COHHON/PLB AS5/  SIGNOR, SNPLOT, IH 

RETUPN 

END 


PLT01312 
PLTC1 31 3 
PLT01314 
PLT01315 
PLT01316 
PLT01317 
PLT01318 
PLT01319 
PLT0132C 
PLT01321 
PLT01322 
PIT01323 
PLT01324 
PLT01325 
PIT01326 
PLT01327 
PLT01328 
PLT01329 
PLT01330 
PLT01331 
PLT01332 
PLT01333 
PLT01334 


